packages feed

seihou-core (empty) → 0.4.0.0

raw patch · 120 files changed

+23023/−0 lines, 120 filesdep +aesondep +aeson-prettydep +base

Dependencies added: aeson, aeson-pretty, base, base16-bytestring, bytestring, containers, cryptohash-sha256, dhall, directory, effectful-core, either, filepath, generic-lens, hspec, lens, process, seihou-core, tasty, tasty-hspec, temporary, text, time, transformers, yaml

Files

+ LICENSE view
@@ -0,0 +1,28 @@+BSD 3-Clause License++Copyright (c) 2026, Nadeem Bitar++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++1. Redistributions of source code must retain the above copyright notice, this+   list of conditions and the following disclaimer.++2. Redistributions in binary form must reproduce the above copyright notice,+   this list of conditions and the following disclaimer in the documentation+   and/or other materials provided with the distribution.++3. Neither the name of the copyright holder nor the names of its contributors+   may be used to endorse or promote products derived from this software+   without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"+AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE+IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE+DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE+FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL+DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR+SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER+CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY,+OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ seihou-core.cabal view
@@ -0,0 +1,205 @@+cabal-version: 3.0+name: seihou-core+version: 0.4.0.0+synopsis: Core library for Seihou project scaffolding+description:+  Core library for Seihou, a composable project scaffolding system.+  It provides the types, Dhall loading, template rendering, execution+  engine, manifest handling, and validation logic used by the Seihou CLI.++homepage: https://github.com/shinzui/seihou+bug-reports: https://github.com/shinzui/seihou/issues+license: BSD-3-Clause+license-file: LICENSE+author: Nadeem Bitar+maintainer: nadeem@gmail.com+copyright: (c) 2026 Nadeem Bitar+category: Development+build-type: Simple++source-repository head+  type: git+  location: https://github.com/shinzui/seihou.git++library+  default-language: GHC2024+  default-extensions:+    DuplicateRecordFields+    NoFieldSelectors+    OverloadedLabels+    OverloadedRecordDot+    OverloadedStrings+    TypeFamilies++  hs-source-dirs: src+  exposed-modules:+    Seihou.Composition.Graph+    Seihou.Composition.Instance+    Seihou.Composition.Plan+    Seihou.Composition.Recipe+    Seihou.Composition.Resolve+    Seihou.Core.AgentPrompt+    Seihou.Core.Blueprint+    Seihou.Core.CommandVar+    Seihou.Core.Context+    Seihou.Core.Expr+    Seihou.Core.Install+    Seihou.Core.Migration+    Seihou.Core.Module+    Seihou.Core.Path+    Seihou.Core.Recipe+    Seihou.Core.Registry+    Seihou.Core.Scaffold+    Seihou.Core.SchemaUpgrade+    Seihou.Core.Status+    Seihou.Core.Types+    Seihou.Core.Variable+    Seihou.Core.Version+    Seihou.Dhall.Config+    Seihou.Dhall.Eval+    Seihou.Effect.ConfigReader+    Seihou.Effect.ConfigReaderInterp+    Seihou.Effect.ConfigReaderPure+    Seihou.Effect.ConfigWriter+    Seihou.Effect.ConfigWriterInterp+    Seihou.Effect.ConfigWriterPure+    Seihou.Effect.Console+    Seihou.Effect.ConsoleInterp+    Seihou.Effect.ConsolePure+    Seihou.Effect.DhallEval+    Seihou.Effect.DhallEvalInterp+    Seihou.Effect.Filesystem+    Seihou.Effect.FilesystemInterp+    Seihou.Effect.FilesystemPure+    Seihou.Effect.Logger+    Seihou.Effect.LoggerInterp+    Seihou.Effect.LoggerPure+    Seihou.Effect.ManifestStore+    Seihou.Effect.ManifestStoreInterp+    Seihou.Effect.ManifestStorePure+    Seihou.Effect.Process+    Seihou.Effect.ProcessInterp+    Seihou.Effect.ProcessPure+    Seihou.Engine.Conflict+    Seihou.Engine.DhallJSON+    Seihou.Engine.Diff+    Seihou.Engine.Execute+    Seihou.Engine.Migrate+    Seihou.Engine.Plan+    Seihou.Engine.Preview+    Seihou.Engine.Remove+    Seihou.Engine.Section+    Seihou.Engine.Template+    Seihou.Engine.TypedDhallText+    Seihou.Engine.Validate+    Seihou.Interaction.Confirm+    Seihou.Interaction.Prompt+    Seihou.Manifest.Hash+    Seihou.Manifest.Types+    Seihou.Prelude++  build-depends:+    aeson >=2.1 && <3,+    aeson-pretty >=0.8 && <1,+    base >=4.18 && <5,+    base16-bytestring >=1.0 && <2,+    bytestring >=0.11 && <1,+    containers >=0.6 && <1,+    cryptohash-sha256 >=0.11 && <1,+    dhall >=1.42 && <2,+    directory >=1.3 && <2,+    effectful-core >=2.4 && <3,+    either >=5 && <6,+    filepath >=1.4 && <2,+    generic-lens >=2.2 && <3,+    lens >=5.2 && <6,+    process >=1.6 && <2,+    text >=2.0 && <3,+    time >=1.12 && <2,+    transformers >=0.6 && <1,+    yaml >=0.11 && <1,++test-suite seihou-core-test+  type: exitcode-stdio-1.0+  default-language: GHC2024+  default-extensions:+    DuplicateRecordFields+    NoFieldSelectors+    OverloadedLabels+    OverloadedRecordDot+    OverloadedStrings++  hs-source-dirs: test+  main-is: Main.hs+  other-modules:+    Seihou.Composition.GraphSpec+    Seihou.Composition.InstanceSpec+    Seihou.Composition.PlanSpec+    Seihou.Composition.RecipeSpec+    Seihou.Composition.ResolveSpec+    Seihou.Core.AgentPromptSpec+    Seihou.Core.BlueprintSpec+    Seihou.Core.CommandVarSpec+    Seihou.Core.ContextSpec+    Seihou.Core.ExprSpec+    Seihou.Core.InstallSpec+    Seihou.Core.ListSpec+    Seihou.Core.MigrationSpec+    Seihou.Core.ModuleSpec+    Seihou.Core.RecipeSpec+    Seihou.Core.RegistryEmitSpec+    Seihou.Core.RegistrySpec+    Seihou.Core.RegistrySyncSpec+    Seihou.Core.ScaffoldSpec+    Seihou.Core.SchemaUpgradeSpec+    Seihou.Core.StatusSpec+    Seihou.Core.TypesSpec+    Seihou.Core.VariableSpec+    Seihou.Core.VersionSpec+    Seihou.Dhall.ConfigSpec+    Seihou.Dhall.EvalSpec+    Seihou.Dhall.MigrationDecoderSpec+    Seihou.Effect.ConfigReaderSpec+    Seihou.Effect.ConfigWriterSpec+    Seihou.Effect.FilesystemSpec+    Seihou.Effect.LoggerSpec+    Seihou.Effect.ManifestStoreSpec+    Seihou.Engine.ConflictSpec+    Seihou.Engine.DiffSpec+    Seihou.Engine.ExecuteSpec+    Seihou.Engine.MigrateSpec+    Seihou.Engine.PlanSpec+    Seihou.Engine.PreviewSpec+    Seihou.Engine.RemoveSpec+    Seihou.Engine.SectionSpec+    Seihou.Engine.TemplateSpec+    Seihou.Engine.ValidateSpec+    Seihou.Evaluation.ConditionalTemplateSpec+    Seihou.Evaluation.DhallTextFlakeSpec+    Seihou.Evaluation.SplitFlakeSpec+    Seihou.Evaluation.TypedDhallTextSpec+    Seihou.Integration.CompositionSpec+    Seihou.Integration.ExecutionSpec+    Seihou.Integration.GenerationSpec+    Seihou.Integration.ModuleLoadSpec+    Seihou.Interaction.ConfirmSpec+    Seihou.Interaction.PromptSpec+    Seihou.Manifest.TypesSpec++  build-depends:+    aeson >=2.1 && <3,+    base >=4.18 && <5,+    bytestring >=0.11 && <1,+    containers >=0.6 && <1,+    dhall >=1.42 && <2,+    directory >=1.3 && <2,+    effectful-core >=2.4 && <3,+    filepath >=1.4 && <2,+    hspec >=2.11 && <3,+    seihou-core,+    tasty >=1.4 && <2,+    tasty-hspec >=1.2 && <2,+    temporary >=1.3 && <2,+    text >=2.0 && <3,+    time >=1.12 && <2,+    yaml >=0.11 && <1,
+ src/Seihou/Composition/Graph.hs view
@@ -0,0 +1,101 @@+module Seihou.Composition.Graph+  ( CompositionGraph (..),+    buildGraph,+    topoSort,+  )+where++import Data.Map.Strict qualified as Map+import Data.Set qualified as Set+import Seihou.Composition.Instance (ModuleInstance (..), mkInstance)+import Seihou.Core.Types+import Seihou.Prelude++-- | A directed acyclic graph of module instances.+--+-- Edges point from a 'ModuleInstance' to the instances of its direct+-- dependencies: two invocations of the same module with different+-- 'ParentVars' have independent edges, so the topological sort+-- produces one node per distinct invocation.+data CompositionGraph = CompositionGraph+  { cgModules :: Map ModuleInstance Module,+    cgEdges :: Map ModuleInstance [ModuleInstance]+  }+  deriving stock (Eq, Show)++-- | Build a composition graph from a list of module instances.+--+-- Each module's dependencies are resolved to the corresponding+-- 'ModuleInstance' present in the input. A dependency edge with+-- @depVars@ selects the instance created with those exact bindings;+-- a bare dependency (no @depVars@) selects the 'emptyParentVars'+-- instance. If the instance set does not contain the child the edge+-- points to, the edge is silently dropped — the loader is+-- responsible for ensuring every referenced child is loaded first.+buildGraph :: [(ModuleInstance, Module)] -> CompositionGraph+buildGraph entries =+  let present = Set.fromList (map fst entries)+      edgesFor m =+        -- Dedupe edges: if a parent lists the same @(depModule, depVars)@+        -- twice, the two edges resolve to the same child instance and+        -- must count as one for the topological sort's in-degree.+        Set.toAscList . Set.fromList $+          [ child+          | dep <- m.dependencies,+            let child = mkInstance dep.depModule (parentVarsFromDep dep),+            Set.member child present+          ]+   in CompositionGraph+        { cgModules = Map.fromList entries,+          cgEdges = Map.fromList [(inst, edgesFor m) | (inst, m) <- entries]+        }++-- | Topological sort using Kahn's algorithm, operating on+-- 'ModuleInstance' nodes.+--+-- Returns instances in execution order (dependencies first) or a+-- 'CircularDependency' error if a cycle exists. The error payload+-- lists bare module names because that is what callers expect+-- today; the set can include duplicates when two instances of the+-- same module both sit in a cycle.+topoSort :: CompositionGraph -> Either ModuleLoadError [ModuleInstance]+topoSort graph = kahn initialReady initialInDegree [] allNodes+  where+    allNodes :: Set ModuleInstance+    allNodes = Map.keysSet graph.cgEdges++    initialInDegree :: Map ModuleInstance Int+    initialInDegree =+      Map.fromList+        [ (n, length [d | d <- Map.findWithDefault [] n graph.cgEdges, Set.member d allNodes])+        | n <- Set.toList allNodes+        ]++    initialReady :: [ModuleInstance]+    initialReady =+      [ n+      | (n, deg) <- Map.toList initialInDegree,+        deg == 0+      ]++    kahn :: [ModuleInstance] -> Map ModuleInstance Int -> [ModuleInstance] -> Set ModuleInstance -> Either ModuleLoadError [ModuleInstance]+    kahn [] _ result remaining+      | Set.null remaining = Right (reverse result)+      | otherwise =+          Left (CircularDependency (map (.instanceModule) (Set.toList remaining)))+    kahn (node : rest) inDeg result remaining =+      let remaining' = Set.delete node remaining+          (newReady, inDeg') = foldl (decrementDep node) ([], inDeg) (Set.toList remaining')+       in kahn (rest ++ newReady) inDeg' (node : result) remaining'++    decrementDep :: ModuleInstance -> ([ModuleInstance], Map ModuleInstance Int) -> ModuleInstance -> ([ModuleInstance], Map ModuleInstance Int)+    decrementDep processed (ready, inDeg) candidate =+      let deps = Map.findWithDefault [] candidate graph.cgEdges+       in if processed `elem` deps+            then+              let newDeg = Map.findWithDefault 0 candidate inDeg - 1+                  inDeg' = Map.insert candidate newDeg inDeg+               in if newDeg == 0+                    then (candidate : ready, inDeg')+                    else (ready, inDeg')+            else (ready, inDeg)
+ src/Seihou/Composition/Instance.hs view
@@ -0,0 +1,86 @@+module Seihou.Composition.Instance+  ( ModuleInstance (..),+    mkInstance,+    primaryInstance,+    qualifiedName,+    stableHash,+  )+where++import Crypto.Hash.SHA256 qualified as SHA256+import Data.ByteString.Base16 qualified as Base16+import Data.Map.Strict qualified as Map+import Data.Text qualified as T+import Data.Text.Encoding qualified as TE+import Seihou.Core.Types+  ( ModuleName (..),+    ParentVars (..),+    VarName (..),+    emptyParentVars,+  )+import Seihou.Prelude++-- | Identity of a module invocation within a composition.+--+-- Two invocations of the same module with different parent-supplied+-- bindings are distinct instances; two with identical bindings share+-- one instance. See @docs/plans/10-parameterized-dep-multi-instantiation.md@+-- for the full rationale.+data ModuleInstance = ModuleInstance+  { instanceModule :: ModuleName,+    instanceParentVars :: ParentVars+  }+  deriving stock (Eq, Ord, Show)++-- | Build a 'ModuleInstance' from a module name and the parent-supplied+-- bindings along the edge that reached it.+mkInstance :: ModuleName -> ParentVars -> ModuleInstance+mkInstance n pv = ModuleInstance {instanceModule = n, instanceParentVars = pv}++-- | The 'ModuleInstance' for a top-level (primary / CLI-additional /+-- recipe-expanded) module, which receives no parent-supplied bindings.+primaryInstance :: ModuleName -> ModuleInstance+primaryInstance n = mkInstance n emptyParentVars++-- | Collapse a 'ModuleInstance' to a 'ModuleName' that is unique within+-- a single composition.+--+-- When the instance has no parent-supplied bindings, the bare module+-- name is returned unchanged — single-instance compositions continue+-- to use plain names in file records, patch operations, and manifest+-- keys. When bindings are present, an @\#@-suffixed 'stableHash' of+-- those bindings is appended so two instances of the same module do+-- not collide.+--+-- This function is only used where a 'ModuleName' must be unique+-- within a composition (e.g. 'FileRecord.moduleName',+-- 'PatchFileOp.moduleName', internal manifest grouping keys). User-+-- facing provenance such as 'VarSource.FromParent' keeps the bare+-- 'ModuleName' alongside the bindings so output stays readable.+qualifiedName :: ModuleInstance -> ModuleName+qualifiedName inst =+  case Map.null inst.instanceParentVars.unParentVars of+    True -> inst.instanceModule+    False ->+      ModuleName $+        inst.instanceModule.unModuleName+          <> "#"+          <> stableHash inst.instanceParentVars++-- | Compute the disambiguating hash for a 'ParentVars' set.+--+-- Canonicalisation: the bindings are sorted ascending by 'VarName',+-- each rendered as @name=value@, and the lines joined with @\\n@.+-- The UTF-8 bytes of that canonical string are hashed with SHA-256+-- and the first eight hex characters of the digest are returned.+--+-- The hash is only a within-composition disambiguator; collision+-- probability at 2^32 is acceptable for compositions of realistic+-- size.+stableHash :: ParentVars -> Text+stableHash (ParentVars m) =+  let sorted = Map.toAscList m+      canonical = T.intercalate "\n" [n <> "=" <> v | (VarName n, v) <- sorted]+      digest = SHA256.hash (TE.encodeUtf8 canonical)+      hex = TE.decodeUtf8 (Base16.encode digest)+   in T.take 8 hex
+ src/Seihou/Composition/Plan.hs view
@@ -0,0 +1,239 @@+module Seihou.Composition.Plan+  ( compileComposedPlan,+    mergeOperations,+    mergeStructuredContent,+    deepMergeJSON,+  )+where++import Data.Aeson qualified as Aeson+import Data.Aeson.Encode.Pretty qualified as AesonPretty+import Data.Aeson.KeyMap qualified as KM+import Data.Map.Strict qualified as Map+import Data.Set qualified as Set+import Data.Text qualified as T+import Data.Text.Encoding qualified as TE+import Data.Text.Lazy qualified as TL+import Data.Text.Lazy.Encoding qualified as TLE+import Data.Yaml qualified as Yaml+import Seihou.Composition.Instance (ModuleInstance, qualifiedName)+import Seihou.Core.Types+import Seihou.Engine.Plan (compilePlan)+import Seihou.Engine.Section (applyTextPatch)+import Seihou.Prelude+import System.FilePath (takeExtension)++-- | Compile plans for all modules in execution order and merge into a+-- single operation list. File conflicts are resolved by last-writer-wins+-- with 'CompositionWarning' entries for overwritten files.+--+-- Each triple is a distinct 'ModuleInstance' invocation. The instance's+-- 'qualifiedName' is passed to 'compilePlan' for any field that must be+-- unique within the composition ('FileRecord.moduleName',+-- 'PatchFileOp.moduleName'), so two instances of the same module do not+-- collide on file ownership.+compileComposedPlan ::+  [(ModuleInstance, Module, FilePath, Map VarName VarValue)] ->+  IO (Either [Text] ([Operation], [CompositionWarning], Map FilePath ModuleName))+compileComposedPlan modules = do+  results <- mapM compileOne modules+  let (errs, opsPerModule) = partitionResults results+  if null errs+    then pure (Right (mergeOperations opsPerModule))+    else pure (Left (concat errs))+  where+    compileOne (inst, m, dir, vars) = do+      let qn = qualifiedName inst+          instancedModule =+            Module+              { name = qn,+                version = m.version,+                description = m.description,+                vars = m.vars,+                exports = m.exports,+                prompts = m.prompts,+                steps = m.steps,+                commands = m.commands,+                dependencies = m.dependencies,+                removal = m.removal,+                migrations = m.migrations+              }+      result <- compilePlan dir instancedModule vars+      case result of+        Left errs -> pure (Left errs)+        Right ops -> pure (Right (qn, ops))++-- | Merge operation lists from multiple modules, handling file conflicts.+--+-- When two modules produce a 'WriteFileOp' or 'CopyFileOp' targeting the+-- same destination path, the later module (later in execution order) wins+-- and a 'FileOverwritten' warning is recorded.+--+-- 'CreateDirOp' operations are silently deduplicated.+-- 'RunCommandOp' operations are always included.+mergeOperations ::+  [(ModuleName, [Operation])] ->+  ([Operation], [CompositionWarning], Map FilePath ModuleName)+mergeOperations moduleOps =+  let tagged = [(name, op) | (name, ops) <- moduleOps, op <- ops]+      (result, warnings, owners) = go tagged Map.empty Set.empty [] []+   in (reverse result, warnings, owners)+  where+    go [] fileOwner _ opsAcc warningsAcc = (opsAcc, warningsAcc, fileOwner)+    go ((name, op) : rest) fileOwner seenDirs opsAcc warningsAcc =+      case op of+        CreateDirOp p+          | Set.member p seenDirs -> go rest fileOwner seenDirs opsAcc warningsAcc+          | otherwise -> go rest fileOwner (Set.insert p seenDirs) (op : opsAcc) warningsAcc+        WriteFileOp dest _ _ ->+          handleFileOp name op dest rest fileOwner seenDirs opsAcc warningsAcc+        CopyFileOp _ dest ->+          handleFileOp name op dest rest fileOwner seenDirs opsAcc warningsAcc+        RunCommandOp {} ->+          go rest fileOwner seenDirs (op : opsAcc) warningsAcc+        PatchFileOp dest newContent patchOp' _ patchModName ->+          handlePatchOp name dest newContent patchOp' patchModName rest fileOwner seenDirs opsAcc warningsAcc++    -- \| Handle a PatchFileOp: if the target file exists in the accumulator,+    -- apply the patch to the existing content. Otherwise, treat it like a+    -- new file operation (the patch creates the file from empty).+    handlePatchOp name dest newContent patchOp' patchModName rest fileOwner seenDirs opsAcc warningsAcc =+      case findWriteOp dest opsAcc of+        Just (WriteFileOp _ existingContent strat, otherOps) ->+          -- Apply patch to the existing WriteFileOp's content+          case applyTextPatch patchOp' patchModName "#" existingContent newContent of+            Left _err ->+              -- On patch failure, fall back to last-writer-wins+              handleFileOp name (WriteFileOp dest newContent Template) dest rest fileOwner seenDirs opsAcc warningsAcc+            Right merged ->+              let baseName = case Map.lookup dest fileOwner of+                    Just n -> n+                    Nothing -> name+                  updatedOp = WriteFileOp dest merged strat+               in go+                    rest+                    (Map.insert dest name fileOwner)+                    seenDirs+                    (updatedOp : otherOps)+                    (ContentMerged dest baseName name : warningsAcc)+        _ ->+          -- No existing file op for this dest; preserve as PatchFileOp so the+          -- execution engine can merge with the on-disk file and the diff engine+          -- can avoid false conflict classification.+          let patchOp = PatchFileOp dest newContent patchOp' Template patchModName+           in go+                rest+                (Map.insert dest name fileOwner)+                seenDirs+                (patchOp : opsAcc)+                warningsAcc++    handleFileOp name op dest rest fileOwner seenDirs opsAcc warningsAcc =+      case Map.lookup dest fileOwner of+        Just prevName ->+          -- Check for structured merge: both ops are WriteFileOp with Structured strategy+          case (findWriteOp dest opsAcc, op) of+            (Just (WriteFileOp _ existingContent Structured, otherOps), WriteFileOp _ newContent Structured) ->+              case mergeStructuredContent dest existingContent newContent of+                Right merged ->+                  let updatedOp = WriteFileOp dest merged Structured+                   in go+                        rest+                        (Map.insert dest name fileOwner)+                        seenDirs+                        (updatedOp : otherOps)+                        (ContentMerged dest prevName name : warningsAcc)+                Left _ ->+                  -- On merge failure, fall back to last-writer-wins+                  let opsAcc' = op : filter (\old -> destOfOp old /= Just dest) opsAcc+                   in go+                        rest+                        (Map.insert dest name fileOwner)+                        seenDirs+                        opsAcc'+                        (FileOverwritten dest prevName name : warningsAcc)+            _ ->+              -- Default: last-writer-wins+              let opsAcc' = op : filter (\old -> destOfOp old /= Just dest) opsAcc+               in go+                    rest+                    (Map.insert dest name fileOwner)+                    seenDirs+                    opsAcc'+                    (FileOverwritten dest prevName name : warningsAcc)+        Nothing ->+          go+            rest+            (Map.insert dest name fileOwner)+            seenDirs+            (op : opsAcc)+            warningsAcc++-- | Find and extract a WriteFileOp targeting a given destination from the ops accumulator.+-- Returns the matching op and the remaining ops (with it removed).+findWriteOp :: FilePath -> [Operation] -> Maybe (Operation, [Operation])+findWriteOp _ [] = Nothing+findWriteOp dest (op@(WriteFileOp d _ _) : rest)+  | d == dest = Just (op, rest)+findWriteOp dest (op : rest) =+  case findWriteOp dest rest of+    Just (found, remaining) -> Just (found, op : remaining)+    Nothing -> Nothing++-- | Extract the destination path from a file-producing operation.+destOfOp :: Operation -> Maybe FilePath+destOfOp (WriteFileOp d _ _) = Just d+destOfOp (CopyFileOp _ d) = Just d+destOfOp (PatchFileOp d _ _ _ _) = Just d+destOfOp _ = Nothing++-- | Merge two serialized structured files (JSON or YAML) by deep-merging+-- their contents. The file extension determines the parse/serialize format.+-- Right-biased: overlapping scalar keys take the overlay's value; nested+-- objects are merged recursively.+mergeStructuredContent :: FilePath -> Text -> Text -> Either Text Text+mergeStructuredContent dest base overlay = do+  baseVal <- parseStructured dest base+  overlayVal <- parseStructured dest overlay+  let merged = deepMergeJSON baseVal overlayVal+  serializeStructured dest merged++-- | Parse serialized content based on file extension.+parseStructured :: FilePath -> Text -> Either Text Aeson.Value+parseStructured dest content =+  case takeExtension dest of+    ".json" ->+      case Aeson.eitherDecodeStrict' (TE.encodeUtf8 content) of+        Left err -> Left ("Failed to parse JSON in " <> T.pack dest <> ": " <> T.pack err)+        Right val -> Right val+    ".yaml" -> parseYaml dest content+    ".yml" -> parseYaml dest content+    ext -> Left ("Structured merge: unsupported format '" <> T.pack ext <> "'")+  where+    parseYaml d c =+      case Yaml.decodeEither' (TE.encodeUtf8 c) of+        Left err -> Left ("Failed to parse YAML in " <> T.pack d <> ": " <> T.pack (show err))+        Right val -> Right val++-- | Serialize a JSON value based on file extension.+serializeStructured :: FilePath -> Aeson.Value -> Either Text Text+serializeStructured dest value =+  case takeExtension dest of+    ".json" -> Right (TL.toStrict (TLE.decodeUtf8 (AesonPretty.encodePretty value)) <> "\n")+    ".yaml" -> Right (TE.decodeUtf8 (Yaml.encode value))+    ".yml" -> Right (TE.decodeUtf8 (Yaml.encode value))+    ext -> Left ("Structured merge: unsupported format '" <> T.pack ext <> "'")++-- | Deep-merge two JSON values. For objects, keys are merged recursively.+-- For all other types, the right (overlay) value wins.+deepMergeJSON :: Aeson.Value -> Aeson.Value -> Aeson.Value+deepMergeJSON (Aeson.Object base) (Aeson.Object overlay) =+  Aeson.Object (KM.unionWith deepMergeJSON base overlay)+deepMergeJSON _ overlay = overlay++-- | Partition a list of Either into errors and successes.+partitionResults :: [Either e a] -> ([e], [a])+partitionResults = foldr step ([], [])+  where+    step (Left e) (errs, oks) = (e : errs, oks)+    step (Right a) (errs, oks) = (errs, a : oks)
+ src/Seihou/Composition/Recipe.hs view
@@ -0,0 +1,30 @@+module Seihou.Composition.Recipe+  ( expandRecipe,+  )+where++import Data.Map.Strict (Map)+import Data.Map.Strict qualified as Map+import Data.Text (Text)+import Seihou.Core.Recipe (validateRecipe)+import Seihou.Core.Types++type ExpandedRecipe = (ModuleName, [ModuleName], Map VarName Text, [VarDecl], [Prompt])++-- | 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.+--+-- The first module in the recipe's list becomes the primary module (used for+-- config namespace derivation). All remaining modules become additional modules.+-- Variable overrides are collected from each module entry's @depVars@ bindings.+expandRecipe :: Recipe -> Either [Text] ExpandedRecipe+expandRecipe recipe = do+  validated <- validateRecipe recipe+  case validated.modules of+    [] -> Left ["recipe must list at least one module"]+    primary : additional ->+      let primaryName = primary.depModule+          additionalNames = map (.depModule) additional+          overrides = Map.unions (map (.depVars) validated.modules)+       in Right (primaryName, additionalNames, overrides, validated.vars, validated.prompts)
+ src/Seihou/Composition/Resolve.hs view
@@ -0,0 +1,387 @@+module Seihou.Composition.Resolve+  ( loadComposition,+    resolveComposedVariables,+    resolveWithPrompts,+    exportedVars,+    collectParentVars,+  )+where++import Control.Monad.Trans.Except (ExceptT (..), runExceptT)+import Data.Map.Strict qualified as Map+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.Module (discoverModule, validateModule)+import Seihou.Core.Types+import Seihou.Core.Variable (resolveVariables)+import Seihou.Dhall.Eval (evalModuleFromFile)+import Seihou.Effect.Console (Console, isInteractive, putText)+import Seihou.Interaction.Prompt (runPrompts)+import Seihou.Prelude++-- | Load all modules in a composition: primary + additional + transitive deps.+-- Additional modules are treated as implicit dependencies of the primary module.+-- Returns modules with their directories in execution order (dependencies first).+--+-- Each entry carries a 'ModuleInstance' identifying the exact invocation.+-- Two dependency edges to the same module with different @depVars@ produce+-- two distinct entries; identical edges dedupe.+loadComposition ::+  [FilePath] ->+  ModuleName ->+  [ModuleName] ->+  IO (Either ModuleLoadError [(ModuleInstance, Module, FilePath)])+loadComposition searchPaths primary additional = runExceptT $ do+  (primaryMod, primaryDir) <- ExceptT $ loadModuleWithDir searchPaths primary+  let effectiveDeps = primaryMod.dependencies ++ map simpleDep additional+      effectivePrimary = primaryMod {dependencies = nubOrdBy (.depModule) effectiveDeps}+      primaryInst = primaryInstance primary+      loaded = Map.singleton primaryInst (effectivePrimary, primaryDir)+      seeds = [(mkInstance dep.depModule (parentVarsFromDep dep)) | dep <- effectivePrimary.dependencies]+  allInstances <- ExceptT $ loadTransitive searchPaths loaded seeds+  let entries = [(inst, m) | (inst, (m, _)) <- Map.toList allInstances]+      graph = buildGraph entries+  order <- ExceptT . pure $ topoSort graph+  pure [(inst, m, d) | inst <- order, Just (m, d) <- [Map.lookup inst allInstances]]++-- | Resolve variables for all modules in a composition with export visibility.+--+-- For each module-instance in execution order:+-- 1. Collect exported variables from its direct dependency edges (resolved+--    to the exact child instance along that edge, not just the module name).+-- 2. Inject those exports as defaults for any matching declared variables.+-- 3. Call 'resolveVariables' with the adjusted declarations.+-- 4. Record the instance's exports for downstream modules.+--+-- Exported values override the module's own defaults but are still lower+-- priority than CLI overrides and environment variables.+resolveComposedVariables ::+  [(ModuleInstance, Module, FilePath)] ->+  Map VarName Text ->+  Map Text Text ->+  Text ->+  Text ->+  Map VarName Text ->+  Map VarName Text ->+  Map VarName Text ->+  Map VarName Text ->+  Either [VarError] (Map ModuleInstance (Map VarName ResolvedVar))+resolveComposedVariables modulesInOrder cliOverrides envVars namespace context localConfig nsConfig ctxConfig globalConfig =+  let allParentVars = collectParentVars modulesInOrder+   in go allParentVars modulesInOrder Map.empty Map.empty+  where+    go ::+      Map ModuleInstance (Map VarName (Text, ModuleName)) ->+      [(ModuleInstance, Module, FilePath)] ->+      Map ModuleInstance (Map VarName ResolvedVar) ->+      Map ModuleInstance (Map VarName VarValue) ->+      Either [VarError] (Map ModuleInstance (Map VarName ResolvedVar))+    go _ [] perModule _ = Right perModule+    go parentVarsMap ((inst, m, _dir) : rest) perModule allExports = do+      let visibleExports = gatherEdgeExports m allExports+          adjustedDecls = map (injectExportDefault visibleExports) m.vars+          myParentVars = Map.findWithDefault Map.empty inst parentVarsMap+      resolved <- resolveVariables adjustedDecls cliOverrides envVars namespace context localConfig nsConfig ctxConfig globalConfig myParentVars+      let declaredNames = Set.fromList (map (.name) m.vars)+          inherited =+            Map.mapWithKey+              makeInheritedResolved+              (Map.filterWithKey (\k _ -> not (Set.member k declaredNames)) visibleExports)+          fullResolved = resolved `Map.union` inherited+      let myExports = exportedVars m fullResolved+      go+        parentVarsMap+        rest+        (Map.insert inst fullResolved perModule)+        (Map.insert inst myExports allExports)++-- | Resolve variables for all modules with interactive prompt support.+--+-- Same as 'resolveComposedVariables' but when a module has unresolved required+-- variables, prompts the user via the Console effect (if interactive).+-- In non-interactive mode, missing required variables remain as errors.+resolveWithPrompts ::+  (Console :> es) =>+  [(ModuleInstance, Module, FilePath)] ->+  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 ModuleInstance (Map VarName ResolvedVar)))+resolveWithPrompts modulesInOrder cliOverrides envVars namespace context localConfig nsConfig ctxConfig globalConfig = do+  interactive <- isInteractive+  let allParentVars = collectParentVars modulesInOrder+  goPrompt interactive allParentVars modulesInOrder Map.empty Map.empty+  where+    goPrompt ::+      (Console :> es) =>+      Bool ->+      Map ModuleInstance (Map VarName (Text, ModuleName)) ->+      [(ModuleInstance, Module, FilePath)] ->+      Map ModuleInstance (Map VarName ResolvedVar) ->+      Map ModuleInstance (Map VarName VarValue) ->+      Eff es (Either [VarError] (Map ModuleInstance (Map VarName ResolvedVar)))+    goPrompt _ _ [] perModule _ = pure (Right perModule)+    goPrompt interactive parentVarsMap ((inst, m, _dir) : rest) perModule allExports = do+      let visibleExports = gatherEdgeExports m allExports+          adjustedDecls = map (injectExportDefault visibleExports) m.vars+          myParentVars = Map.findWithDefault Map.empty inst parentVarsMap+      case resolveVariables adjustedDecls cliOverrides envVars namespace context localConfig nsConfig ctxConfig globalConfig myParentVars of+        Right resolved -> do+          let declaredNames = Set.fromList (map (.name) m.vars)+              inherited =+                Map.mapWithKey+                  makeInheritedResolved+                  (Map.filterWithKey (\k _ -> not (Set.member k declaredNames)) visibleExports)+              resolvedWithInherited = resolved `Map.union` inherited+          let optionalDecls =+                [ d+                | d <- adjustedDecls,+                  not d.required,+                  not (Map.member d.name resolvedWithInherited),+                  any (\p -> p.var == d.name) m.prompts+                ]+          optionalPrompted <-+            if interactive && not (null optionalDecls)+              then do+                let currentBindings = Map.map (.value) (Map.unions (Map.elems perModule))+                    allBindings = Map.union (Map.map (.value) resolvedWithInherited) currentBindings+                putText ""+                putText "Optional configuration:"+                runPrompts m.prompts optionalDecls allBindings+              else pure Map.empty+          let fullResolved = resolvedWithInherited `Map.union` optionalPrompted+              myExports = exportedVars m fullResolved+          goPrompt+            interactive+            parentVarsMap+            rest+            (Map.insert inst fullResolved perModule)+            (Map.insert inst myExports allExports)+        Left errs -> do+          let (missing, fatal) = partitionErrors errs+          if not (null fatal)+            then pure (Left (fatal ++ missing))+            else+              if not interactive || null missing+                then pure (Left errs)+                else do+                  let currentBindings = Map.map (.value) (Map.unions (Map.elems perModule))+                      missingDecls = [d | d <- adjustedDecls, d.name `elem` map getMissingName missing]+                  prompted <- runPrompts m.prompts missingDecls currentBindings+                  let stillMissing = [e | e <- missing, not (Map.member (getMissingName e) prompted)]+                  if not (null stillMissing)+                    then pure (Left stillMissing)+                    else do+                      let promptedOverrides =+                            Map.union cliOverrides $+                              Map.map (varValueToText . (.value)) prompted+                      case resolveVariables adjustedDecls promptedOverrides envVars namespace context localConfig nsConfig ctxConfig globalConfig myParentVars of+                        Left errs' -> pure (Left errs')+                        Right resolved -> do+                          let resolvedWithPromptSource =+                                Map.mapWithKey+                                  ( \vn rv ->+                                      case Map.lookup vn prompted of+                                        Just pv -> pv+                                        Nothing -> rv+                                  )+                                  resolved+                              declaredNames = Set.fromList (map (.name) m.vars)+                              inherited =+                                Map.mapWithKey+                                  makeInheritedResolved+                                  (Map.filterWithKey (\k _ -> not (Set.member k declaredNames)) visibleExports)+                              resolvedWithInherited' = resolvedWithPromptSource `Map.union` inherited+                          let optionalDecls' =+                                [ d+                                | d <- adjustedDecls,+                                  not d.required,+                                  not (Map.member d.name resolvedWithInherited'),+                                  any (\p -> p.var == d.name) m.prompts+                                ]+                          optionalPrompted' <-+                            if not (null optionalDecls')+                              then do+                                let cb = Map.map (.value) (Map.unions (Map.elems perModule))+                                    ab = Map.union (Map.map (.value) resolvedWithInherited') cb+                                putText ""+                                putText "Optional configuration:"+                                runPrompts m.prompts optionalDecls' ab+                              else pure Map.empty+                          let fullResolved = resolvedWithInherited' `Map.union` optionalPrompted'+                              myExports = exportedVars m fullResolved+                          goPrompt+                            interactive+                            parentVarsMap+                            rest+                            (Map.insert inst fullResolved perModule)+                            (Map.insert inst myExports allExports)++-- | Collect the exports visible along a module's dependency edges.+--+-- Each dependency edge is resolved to the exact child instance+-- @(depModule, depVars)@, not just the module name, so that two+-- sibling instances of the same module contribute their own+-- per-instance exports without interference.+gatherEdgeExports ::+  Module ->+  Map ModuleInstance (Map VarName VarValue) ->+  Map VarName VarValue+gatherEdgeExports m allExports =+  Map.unions+    [ Map.findWithDefault Map.empty childInst allExports+    | dep <- m.dependencies,+      let childInst = mkInstance dep.depModule (parentVarsFromDep dep)+    ]++-- | Extract the variable name from a MissingRequiredVar error.+getMissingName :: VarError -> VarName+getMissingName (MissingRequiredVar n) = n+getMissingName _ = VarName ""++-- | Partition errors into MissingRequiredVar and other (fatal) errors.+partitionErrors :: [VarError] -> ([VarError], [VarError])+partitionErrors = foldr go ([], [])+  where+    go e@(MissingRequiredVar _) (missing, fatal) = (e : missing, fatal)+    go e (missing, fatal) = (missing, e : fatal)++-- | Convert a VarValue to its text representation for use as an override.+varValueToText :: VarValue -> Text+varValueToText (VText t) = t+varValueToText (VBool True) = "true"+varValueToText (VBool False) = "false"+varValueToText (VInt n) = T.pack (show n)+varValueToText (VList vs) = T.intercalate "," (map varValueToText vs)++-- | Extract exported variables from a module's resolved values.+-- Uses the alias name if provided, otherwise the original variable name.+exportedVars :: Module -> Map VarName ResolvedVar -> Map VarName VarValue+exportedVars m resolved =+  Map.fromList+    [ (exportName e, rv.value)+    | e <- m.exports,+      Just rv <- [Map.lookup e.var resolved]+    ]+  where+    exportName e = case e.alias of+      Just a -> a+      Nothing -> e.var++-- Internal helpers++-- | Load a module and return both the module and its directory path.+loadModuleWithDir :: [FilePath] -> ModuleName -> IO (Either ModuleLoadError (Module, FilePath))+loadModuleWithDir searchPaths name = do+  discovered <- discoverModule searchPaths name+  case discovered of+    Left err -> pure (Left err)+    Right moduleDir -> do+      let dhallFile = moduleDir </> "module.dhall"+      decoded <- evalModuleFromFile dhallFile+      case decoded of+        Left err -> pure (Left err)+        Right m -> do+          validated <- validateModule moduleDir m+          case validated of+            Left err -> pure (Left err)+            Right m' -> pure (Right (m', moduleDir))++-- | Recursively load transitive dependencies.+--+-- Work-list entries are 'ModuleInstance' values — the caller has already+-- baked the parent-supplied bindings into each entry. An instance whose+-- @(name, parentVars)@ pair is already loaded is skipped, so two+-- dependency edges with identical parent bindings dedupe. Distinct+-- bindings produce distinct loaded entries even when the bare module+-- name is the same.+loadTransitive ::+  [FilePath] ->+  Map ModuleInstance (Module, FilePath) ->+  [ModuleInstance] ->+  IO (Either ModuleLoadError (Map ModuleInstance (Module, FilePath)))+loadTransitive _ loaded [] = pure (Right loaded)+loadTransitive searchPaths loaded (inst : rest)+  | Map.member inst loaded = loadTransitive searchPaths loaded rest+  | otherwise = do+      result <- loadModuleWithDir searchPaths inst.instanceModule+      case result of+        Left err -> pure (Left err)+        Right (m, dir) -> do+          let loaded' = Map.insert inst (m, dir) loaded+              newInstances =+                [ mkInstance dep.depModule (parentVarsFromDep dep)+                | dep <- m.dependencies+                ]+          loadTransitive searchPaths loaded' (rest ++ newInstances)++-- | Inject an exported value as the default for a variable declaration.+-- The export replaces any existing default, giving it precedence over+-- the module author's default while still being overridable by CLI/env.+injectExportDefault :: Map VarName VarValue -> VarDecl -> VarDecl+injectExportDefault exports decl =+  case Map.lookup decl.name exports of+    Just val -> decl {default_ = Just val}+    Nothing -> decl++-- | Create a ResolvedVar for an inherited (non-declared) export variable.+makeInheritedResolved :: VarName -> VarValue -> ResolvedVar+makeInheritedResolved n val =+  ResolvedVar+    { value = val,+      source = FromDefault,+      decl =+        VarDecl+          { name = n,+            type_ = inferType val,+            default_ = Just val,+            description = Nothing,+            required = False,+            validation = Nothing+          }+    }++-- | Infer the VarType from a VarValue.+inferType :: VarValue -> VarType+inferType (VText _) = VTText+inferType (VBool _) = VTBool+inferType (VInt _) = VTInt+inferType (VList []) = VTList VTText+inferType (VList (v : _)) = VTList (inferType v)++-- | Collect all parent-supplied variable bindings across the composition.+--+-- Returns a map keyed by 'ModuleInstance' — not by bare 'ModuleName' —+-- so two sibling invocations of the same child, each supplied with+-- different bindings by different parents, carry their own edge+-- decorations independently. A child edge's @depVars@ uniquely+-- identifies the target instance, so no merging of overlapping+-- bindings is required: each @(ModuleInstance, edgeVars)@ pair is+-- distinct by construction.+collectParentVars ::+  [(ModuleInstance, Module, FilePath)] ->+  Map ModuleInstance (Map VarName (Text, ModuleName))+collectParentVars modules =+  Map.fromList+    [ (childInst, Map.map (,m.name) dep.depVars)+    | (_, m, _) <- modules,+      dep <- m.dependencies,+      not (Map.null dep.depVars),+      let childInst = mkInstance dep.depModule (parentVarsFromDep dep)+    ]++-- | Remove duplicates from a list while preserving order, using a key function.+nubOrdBy :: (Ord k) => (a -> k) -> [a] -> [a]+nubOrdBy f = go Set.empty+  where+    go _ [] = []+    go seen (x : xs)+      | Set.member (f x) seen = go seen xs+      | otherwise = x : go (Set.insert (f x) seen) xs
+ src/Seihou/Core/AgentPrompt.hs view
@@ -0,0 +1,179 @@+module Seihou.Core.AgentPrompt+  ( validateAgentPrompt,+    checkAgentPromptNameFormat,+    checkAgentPromptVersionPresent,+    checkAgentPromptBodyNonEmpty,+    checkAgentPromptUniqueVars,+    checkAgentPromptPromptRefs,+    checkAgentPromptCommandVars,+    checkAgentPromptGuidance,+    checkAgentPromptFiles,+    checkAgentPromptTags,+    checkAgentPromptAllowedTools,+  )+where++import Data.Set qualified as Set+import Data.Text qualified as T+import Numeric.Natural (Natural)+import Seihou.Core.Expr (exprRefs)+import Seihou.Core.Module (isValidModuleName)+import Seihou.Core.Path (validateProjectRelativePath)+import Seihou.Core.Types+import Seihou.Prelude+import System.Directory (doesFileExist)++-- | Validate a decoded 'AgentPrompt' against the prompt authoring rules.+-- The 'FilePath' is the prompt's base directory (containing @prompt.dhall@).+validateAgentPrompt :: FilePath -> AgentPrompt -> IO (Either ModuleLoadError AgentPrompt)+validateAgentPrompt baseDir p = do+  fileErrs <- checkAgentPromptFiles baseDir p+  let pureErrs =+        checkAgentPromptNameFormat p+          <> checkAgentPromptVersionPresent p+          <> checkAgentPromptBodyNonEmpty p+          <> checkAgentPromptUniqueVars p+          <> checkAgentPromptPromptRefs p+          <> checkAgentPromptCommandVars p+          <> checkAgentPromptGuidance p+          <> checkAgentPromptTags p+          <> checkAgentPromptAllowedTools p+      allErrs = pureErrs <> fileErrs+  pure $+    if null allErrs+      then Right p+      else Left (ValidationError p.name allErrs)++checkAgentPromptNameFormat :: AgentPrompt -> [Text]+checkAgentPromptNameFormat p =+  let n = p.name.unModuleName+   in if T.null n || not (isValidModuleName n)+        then ["prompt name must match [a-z][a-z0-9-]*, got: " <> n]+        else []++checkAgentPromptVersionPresent :: AgentPrompt -> [Text]+checkAgentPromptVersionPresent p = case p.version of+  Nothing -> []+  Just v+    | T.null (T.strip v) -> ["prompt version, if specified, must not be empty"]+    | otherwise -> []++checkAgentPromptBodyNonEmpty :: AgentPrompt -> [Text]+checkAgentPromptBodyNonEmpty p+  | T.null (T.strip p.prompt) = ["prompt body must not be empty"]+  | otherwise = []++checkAgentPromptUniqueVars :: AgentPrompt -> [Text]+checkAgentPromptUniqueVars p =+  let names = map (\d -> d.name.unVarName) p.vars+   in map (\n -> "duplicate variable name: " <> n) (findDupes Set.empty Set.empty names)++checkAgentPromptPromptRefs :: AgentPrompt -> [Text]+checkAgentPromptPromptRefs p =+  let varNames = Set.fromList (map (.name) p.vars)+   in concatMap+        ( \prompt ->+            if Set.member prompt.var varNames+              then []+              else ["prompt references undeclared variable: " <> prompt.var.unVarName]+        )+        p.prompts++checkAgentPromptCommandVars :: AgentPrompt -> [Text]+checkAgentPromptCommandVars p =+  duplicateCommandVars <> concatMap checkCommandVar p.commandVars+  where+    commandNames = map (\cv -> cv.name.unVarName) p.commandVars++    duplicateCommandVars =+      map+        (\n -> "duplicate command variable name: " <> n)+        (findDupes Set.empty Set.empty commandNames)++    checkCommandVar cv =+      checkName cv <> checkRun cv <> checkWorkDir cv.workDir <> checkMaxBytes cv.maxBytes++    checkName cv+      | T.null (T.strip cv.name.unVarName) = ["command variable name must not be empty"]+      | otherwise = []++    checkRun cv+      | T.null (T.strip cv.run) = ["command variable '" <> cv.name.unVarName <> "' run must not be empty"]+      | otherwise = []++    checkWorkDir Nothing = []+    checkWorkDir (Just wd) =+      case validateProjectRelativePath wd of+        Left err -> ["command variable workDir " <> err]+        Right _ -> []++    checkMaxBytes Nothing = []+    checkMaxBytes (Just n)+      | n == 0 = ["command variable maxBytes must be greater than zero"]+      | n > maxReasonableBytes = ["command variable maxBytes must be <= 1048576"]+      | otherwise = []++    maxReasonableBytes :: Natural+    maxReasonableBytes = 1048576++checkAgentPromptGuidance :: AgentPrompt -> [Text]+checkAgentPromptGuidance p =+  concatMap checkGuidance p.guidance+  where+    knownVars = Set.fromList (map (.name) p.vars <> map (.name) p.commandVars)++    checkGuidance g =+      checkTitle g <> checkBody g <> checkConditionRefs g++    checkTitle g+      | T.null (T.strip g.title) = ["guidance title must not be empty"]+      | otherwise = []++    checkBody g+      | T.null (T.strip g.body) = ["guidance body must not be empty"]+      | otherwise = []++    checkConditionRefs g =+      case g.condition of+        Nothing -> []+        Just cond ->+          [ "guidance '" <> g.title <> "' references undeclared variable: " <> ref.unVarName+          | (ref, _) <- exprRefs cond,+            not (Set.member ref knownVars)+          ]++checkAgentPromptFiles :: FilePath -> AgentPrompt -> IO [Text]+checkAgentPromptFiles baseDir p =+  concat+    <$> mapM+      ( \pf -> do+          let path = baseDir </> "files" </> pf.src+          exists <- doesFileExist path+          pure $+            if exists+              then []+              else ["prompt file not found: " <> T.pack pf.src]+      )+      p.files++checkAgentPromptTags :: AgentPrompt -> [Text]+checkAgentPromptTags p =+  [ "tag must not be empty"+  | t <- p.tags,+    T.null (T.strip t)+  ]++checkAgentPromptAllowedTools :: AgentPrompt -> [Text]+checkAgentPromptAllowedTools p = case p.allowedTools of+  Nothing -> []+  Just xs ->+    [ "allowedTools entry must not be empty"+    | t <- xs,+      T.null (T.strip t)+    ]++findDupes :: Set.Set Text -> Set.Set Text -> [Text] -> [Text]+findDupes _ _ [] = []+findDupes seen reported (x : xs)+  | Set.member x seen && not (Set.member x reported) = x : findDupes seen (Set.insert x reported) xs+  | otherwise = findDupes (Set.insert x seen) reported xs
+ src/Seihou/Core/Blueprint.hs view
@@ -0,0 +1,205 @@+module Seihou.Core.Blueprint+  ( validateBlueprint,+    validateBlueprintWith,+    checkBlueprintNameFormat,+    checkBlueprintVersionPresent,+    checkBlueprintPromptNonEmpty,+    checkBlueprintUniqueVars,+    checkBlueprintPromptRefs,+    checkBlueprintBaseModules,+    checkBlueprintBaseModulesWith,+    checkBlueprintFiles,+    checkBlueprintTags,+    checkBlueprintAllowedTools,+  )+where++import Data.Map.Strict qualified as Map+import Data.Set qualified as Set+import Data.Text qualified as T+import Seihou.Core.Module (defaultSearchPaths, discoverRunnable, isValidModuleName)+import Seihou.Core.Types+import Seihou.Prelude+import System.Directory (doesFileExist)++-- | Validate a decoded 'Blueprint' against the documented rules.+-- The 'FilePath' is the blueprint's base directory (containing+-- @blueprint.dhall@).+--+-- Validation rules:+--+--   1. Name format: matches @[a-z][a-z0-9-]*@.+--   2. Version, when given, is non-empty (blueprints may legitimately+--      omit a version during early authoring; we only reject @Just ""@).+--   3. Prompt body is non-empty after trimming.+--   4. Variable names declared in @vars@ are unique.+--   5. Every interactive prompt references a declared variable.+--   6. Each @baseModules@ entry is well-formed (name format and var+--      binding names) and resolves to a module or recipe — not another+--      blueprint and not nothing.+--   7. Every @files@ entry exists at @baseDir/files/SRC@.+--   8. Every tag is non-empty.+--   9. Every @allowedTools@ entry, when set, is non-empty.+validateBlueprint :: FilePath -> Blueprint -> IO (Either ModuleLoadError Blueprint)+validateBlueprint baseDir b = do+  searchPaths <- defaultSearchPaths+  validateBlueprintWith searchPaths baseDir b++-- | Same as 'validateBlueprint' but takes the search paths used for+-- resolving base-module references explicitly. Useful for tests that+-- need to pin the lookup roots; production code should call+-- 'validateBlueprint' which pulls them from 'defaultSearchPaths'.+validateBlueprintWith ::+  [FilePath] ->+  FilePath ->+  Blueprint ->+  IO (Either ModuleLoadError Blueprint)+validateBlueprintWith searchPaths baseDir b = do+  fileErrs <- checkBlueprintFiles baseDir b+  baseErrs <- checkBlueprintBaseModulesWith searchPaths b+  let pureErrs =+        checkBlueprintNameFormat b+          <> checkBlueprintVersionPresent b+          <> checkBlueprintPromptNonEmpty b+          <> checkBlueprintUniqueVars b+          <> checkBlueprintPromptRefs b+          <> checkBlueprintTags b+          <> checkBlueprintAllowedTools b+      allErrs = pureErrs <> fileErrs <> baseErrs+  pure $+    if null allErrs+      then Right b+      else Left (ValidationError b.name allErrs)++-- Rule 1: blueprint name must match [a-z][a-z0-9-]*+checkBlueprintNameFormat :: Blueprint -> [Text]+checkBlueprintNameFormat b =+  let n = b.name.unModuleName+   in if T.null n || not (isValidModuleName n)+        then ["blueprint name must match [a-z][a-z0-9-]*, got: " <> n]+        else []++-- Rule 2: if a version is given it must not be empty+checkBlueprintVersionPresent :: Blueprint -> [Text]+checkBlueprintVersionPresent b = case b.version of+  Nothing -> []+  Just v+    | T.null (T.strip v) -> ["blueprint version, if specified, must not be empty"]+    | otherwise -> []++-- Rule 3: prompt body must not be empty after trimming+checkBlueprintPromptNonEmpty :: Blueprint -> [Text]+checkBlueprintPromptNonEmpty b+  | T.null (T.strip b.prompt) = ["blueprint prompt must not be empty"]+  | otherwise = []++-- Rule 4: declared variable names must be unique+checkBlueprintUniqueVars :: Blueprint -> [Text]+checkBlueprintUniqueVars b =+  let names = map (\d -> d.name.unVarName) b.vars+   in map (\n -> "duplicate variable name: " <> n) (findDupes Set.empty Set.empty names)++findDupes :: Set.Set Text -> Set.Set Text -> [Text] -> [Text]+findDupes _ _ [] = []+findDupes seen reported (x : xs)+  | Set.member x seen && not (Set.member x reported) = x : findDupes seen (Set.insert x reported) xs+  | otherwise = findDupes (Set.insert x seen) reported xs++-- Rule 5: every prompt references a declared variable+checkBlueprintPromptRefs :: Blueprint -> [Text]+checkBlueprintPromptRefs b =+  let varNames = Set.fromList (map (.name) b.vars)+   in concatMap+        ( \p ->+            if Set.member p.var varNames+              then []+              else ["prompt references undeclared variable: " <> p.var.unVarName]+        )+        b.prompts++-- Rule 6: base modules must be well-formed and resolve to a module or+-- recipe (not another blueprint). The check uses the same default+-- search paths as @seihou run@; tests can pass custom roots via+-- 'checkBlueprintBaseModulesWith'.+checkBlueprintBaseModules :: Blueprint -> IO [Text]+checkBlueprintBaseModules b = do+  searchPaths <- defaultSearchPaths+  checkBlueprintBaseModulesWith searchPaths b++checkBlueprintBaseModulesWith :: [FilePath] -> Blueprint -> IO [Text]+checkBlueprintBaseModulesWith searchPaths b =+  concat <$> mapM (checkOne searchPaths) b.baseModules+  where+    checkOne :: [FilePath] -> Dependency -> IO [Text]+    checkOne paths dep = do+      let n = dep.depModule.unModuleName+          nameErrs =+            [ "invalid baseModule name: " <> n+            | not (isValidModuleName n)+            ]+          bindingErrs =+            [ "baseModule '" <> n <> "' has invalid var binding name: " <> vn+            | (VarName vn) <- Map.keys dep.depVars,+              not (isValidVarBindingName vn)+            ]+      resolveErrs <-+        if not (isValidModuleName n)+          then pure []+          else do+            result <- discoverRunnable paths dep.depModule+            pure $ case result of+              Right (RunnableModule _ _) -> []+              Right (RunnableRecipe _ _) -> []+              Right (RunnableBlueprint _ _) ->+                [ "baseModule '"+                    <> n+                    <> "' resolves to a blueprint; baseModules must be modules or recipes"+                ]+              Left (ModuleNotFound _ _) ->+                ["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++-- Rule 7: every @files@ entry's source must exist on disk relative to+-- @baseDir/files/@+checkBlueprintFiles :: FilePath -> Blueprint -> IO [Text]+checkBlueprintFiles baseDir b =+  concat+    <$> mapM+      ( \bf -> do+          let p = baseDir </> "files" </> bf.src+          exists <- doesFileExist p+          pure $+            if exists+              then []+              else ["blueprint file not found: " <> T.pack bf.src]+      )+      b.files++-- Rule 8: tags must not be empty strings+checkBlueprintTags :: Blueprint -> [Text]+checkBlueprintTags b =+  [ "tag must not be empty"+  | t <- b.tags,+    T.null (T.strip t)+  ]++-- Rule 9: @allowedTools@, when set, must contain only non-empty entries+checkBlueprintAllowedTools :: Blueprint -> [Text]+checkBlueprintAllowedTools b = case b.allowedTools of+  Nothing -> []+  Just xs ->+    [ "allowedTools entry must not be empty"+    | t <- xs,+      T.null (T.strip t)+    ]
+ src/Seihou/Core/CommandVar.hs view
@@ -0,0 +1,130 @@+module Seihou.Core.CommandVar+  ( resolveCommandVars,+    planCommandVars,+    commandVarDecl,+  )+where++import Data.Map.Strict qualified as Map+import Data.Text qualified as T+import Seihou.Core.Expr (evalExpr)+import Seihou.Core.Path (validateProjectRelativePath)+import Seihou.Core.Types+import Seihou.Core.Variable (coerceValue, validateVarValue)+import Seihou.Effect.Process (Process, runProcess)+import Seihou.Prelude+import System.Exit (ExitCode (..))++-- | Select command variables that should run. Already-resolved variables keep+-- their existing value; command variables only fill gaps.+planCommandVars :: [CommandVar] -> Map VarName ResolvedVar -> Map VarName VarValue -> [CommandVar]+planCommandVars commandVars existing bindings =+  filter shouldRun commandVars+  where+    conditionBindings = resolvedValues existing <> bindings++    shouldRun cv =+      not (Map.member cv.name existing)+        && maybe True (evalExpr conditionBindings) cv.condition++-- | Return the matching declaration for a command variable, or synthesize a+-- text declaration for prompt-only dynamic context such as @git.branch@.+commandVarDecl :: [VarDecl] -> CommandVar -> VarDecl+commandVarDecl decls cv =+  case filter (\decl -> decl.name == cv.name) decls of+    decl : _ -> decl+    [] ->+      VarDecl+        { name = cv.name,+          type_ = VTText,+          default_ = Nothing,+          description = Nothing,+          required = False,+          validation = Nothing+        }++-- | Resolve command-derived variables through the process effect.+--+-- Existing resolved values have higher precedence and are never overwritten.+-- Command results are accumulated in order so later @when@ expressions can+-- depend on earlier command-derived values.+resolveCommandVars ::+  (Process :> es) =>+  [VarDecl] ->+  [CommandVar] ->+  Map VarName ResolvedVar ->+  Eff es (Either [VarError] (Map VarName ResolvedVar))+resolveCommandVars decls commandVars existing = do+  (errs, resolved) <- go [] existing (resolvedValues existing) commandVars+  pure $+    if null errs+      then Right resolved+      else Left errs+  where+    go errs resolved _bindings [] = pure (reverse errs, resolved)+    go errs resolved bindings (cv : rest)+      | Map.member cv.name resolved = go errs resolved bindings rest+      | maybe False (not . evalExpr bindings) cv.condition = go errs resolved bindings rest+      | otherwise = do+          result <- resolveOne bindings cv+          case result of+            Left err -> go (err : errs) resolved bindings rest+            Right rv ->+              let resolved' = Map.insert cv.name rv resolved+                  bindings' = Map.insert cv.name rv.value bindings+               in go errs resolved' bindings' rest++    resolveOne _bindings cv = do+      let decl = commandVarDecl decls cv+      case validateWorkDir cv of+        Left err -> pure (Left err)+        Right workDir -> do+          (exitCode, stdoutText, stderrText) <- runProcess "sh" ["-c", cv.run] workDir+          pure $ case exitCode of+            ExitSuccess -> coerceCommandOutput decl cv stdoutText+            ExitFailure code ->+              Left $+                ValidationFailed+                  cv.name+                  ( "command failed with exit code "+                      <> T.pack (show code)+                      <> ": "+                      <> summarizeDiagnostic stderrText+                  )++    validateWorkDir :: CommandVar -> Either VarError (Maybe FilePath)+    validateWorkDir cv@CommandVar {workDir = Nothing} = Right Nothing+    validateWorkDir cv@CommandVar {workDir = Just wd} =+      case validateProjectRelativePath wd of+        Left err -> Left (ValidationFailed cv.name ("command variable workDir " <> err))+        Right _ -> Right (Just (T.unpack wd))++coerceCommandOutput :: VarDecl -> CommandVar -> Text -> Either VarError ResolvedVar+coerceCommandOutput decl cv stdoutText = do+  let output =+        if cv.trim+          then T.strip stdoutText+          else stdoutText+  case cv.maxBytes of+    Just n+      | fromIntegral (T.length output) > n ->+          Left (ValidationFailed cv.name ("command output exceeds maxBytes " <> T.pack (show n)))+    _ -> do+      value <- coerceValue decl.name decl.type_ output+      validateVarValue decl value+      Right+        ResolvedVar+          { value = value,+            source = FromCommand cv.run,+            decl = decl+          }++resolvedValues :: Map VarName ResolvedVar -> Map VarName VarValue+resolvedValues = Map.map (.value)++summarizeDiagnostic :: Text -> Text+summarizeDiagnostic t =+  let stripped = T.strip t+   in if T.null stripped+        then "no stderr"+        else T.take 200 stripped
+ src/Seihou/Core/Context.hs view
@@ -0,0 +1,65 @@+module Seihou.Core.Context+  ( resolveContext,+    validateContextName,+  )+where++import Control.Applicative ((<|>))+import Data.Map.Strict qualified as Map+import Data.Text qualified as T+import Data.Text.IO qualified as TIO+import Seihou.Prelude+import System.Directory (XdgDirectory (..), doesFileExist, getCurrentDirectory, getXdgDirectory)++-- | Resolve the active context name from multiple sources in precedence order:+--+-- 1. CLI flag (@--context@)+-- 2. @SEIHOU_CONTEXT@ environment variable+-- 3. Project file @.seihou\/context@ (plain text, single line)+-- 4. Global default @~\/.config\/seihou\/default-context@ (plain text, single line)+--+-- Returns 'Nothing' if no context is active.+resolveContext ::+  Maybe Text ->+  Map Text Text ->+  IO (Maybe Text)+resolveContext cliFlag envVars =+  case nonEmpty cliFlag <|> nonEmpty (Map.lookup "SEIHOU_CONTEXT" envVars) of+    Just ctx -> pure (Just ctx)+    Nothing -> do+      projectCtx <- readProjectContext+      case projectCtx of+        Just ctx -> pure (Just ctx)+        Nothing -> readGlobalDefaultContext+  where+    nonEmpty (Just t) | not (T.null (T.strip t)) = Just (T.strip t)+    nonEmpty _ = Nothing++-- | Validate a context name. Returns 'Nothing' if valid, 'Just errorMsg' if invalid.+validateContextName :: Text -> Maybe Text+validateContextName ctx+  | T.null ctx = Just "context name cannot be empty"+  | ".." `T.isInfixOf` ctx = Just "context name must not contain '..'"+  | "/" `T.isInfixOf` ctx = Just "context name must not contain '/'"+  | otherwise = Nothing++-- Internal helpers++readTextFileMaybe :: FilePath -> IO (Maybe Text)+readTextFileMaybe path = do+  exists <- doesFileExist path+  if exists+    then do+      content <- T.strip <$> TIO.readFile path+      pure $ if T.null content then Nothing else Just content+    else pure Nothing++readProjectContext :: IO (Maybe Text)+readProjectContext = do+  cwd <- getCurrentDirectory+  readTextFileMaybe (cwd </> ".seihou" </> "context")++readGlobalDefaultContext :: IO (Maybe Text)+readGlobalDefaultContext = do+  base <- getXdgDirectory XdgConfig "seihou"+  readTextFileMaybe (base </> "default-context")
+ src/Seihou/Core/Expr.hs view
@@ -0,0 +1,204 @@+module Seihou.Core.Expr+  ( parseExpr,+    evalExpr,+    exprRefs,+  )+where++import Data.Char (isDigit)+import Data.Map.Strict qualified as Map+import Data.Text qualified as T+import Seihou.Core.Types+import Seihou.Prelude++-- | Parse an expression string into an 'Expr' AST.+--+-- Grammar:+--+-- >  expr     = or_expr+-- >  or_expr  = and_expr ("||" and_expr)*+-- >  and_expr = not_expr ("&&" not_expr)*+-- >  not_expr = "!" atom | atom+-- >  atom     = "IsSet" varname+-- >           | "Eq" varname value+-- >           | "(" expr ")"+-- >           | "true" | "false"+-- >  varname  = [a-zA-Z][a-zA-Z0-9._-]*+-- >  value    = quoted_string | bare_word+parseExpr :: Text -> Either Text Expr+parseExpr input =+  let trimmed = T.strip input+   in if T.null trimmed+        then Left "empty expression"+        else case runParser parseOrExpr trimmed of+          Left err -> Left err+          Right (expr, rest)+            | T.null (T.strip rest) -> Right expr+            | otherwise -> Left ("unexpected trailing input: " <> rest)++-- | Evaluate an expression against a map of variable bindings.+evalExpr :: Map VarName VarValue -> Expr -> Bool+evalExpr vars = go+  where+    go (ExprEq name val) = Map.lookup name vars == Just val+    go (ExprAnd l r) = go l && go r+    go (ExprOr l r) = go l || go r+    go (ExprNot e) = not (go e)+    go (ExprIsSet name) = Map.member name vars+    go (ExprLit b) = b++-- | Collect the variables an expression references, paired with the literal+-- each is compared against via 'Eq' (if any).+--+--   * @Eq n v@   → @[(n, Just v)]@+--   * @IsSet n@  → @[(n, Nothing)]@+--   * @And@\/@Or@\/@Not@ recurse into sub-expressions+--   * @Lit@      → @[]@+--+-- Used by authoring-time lint to flag references to undeclared variables and+-- type-inconsistent @Eq@ comparisons. Total over 'Expr'.+exprRefs :: Expr -> [(VarName, Maybe VarValue)]+exprRefs (ExprEq name val) = [(name, Just val)]+exprRefs (ExprIsSet name) = [(name, Nothing)]+exprRefs (ExprAnd l r) = exprRefs l ++ exprRefs r+exprRefs (ExprOr l r) = exprRefs l ++ exprRefs r+exprRefs (ExprNot e) = exprRefs e+exprRefs (ExprLit _) = []++-- Parser internals: a parser consumes text and returns the result plus unconsumed input.+type Parser a = Text -> Either Text (a, Text)++runParser :: Parser a -> Text -> Either Text (a, Text)+runParser = id++parseOrExpr :: Parser Expr+parseOrExpr input = do+  (left, rest) <- parseAndExpr input+  parseOrRest left rest++parseOrRest :: Expr -> Parser Expr+parseOrRest left input =+  let stripped = T.strip input+   in if "||" `T.isPrefixOf` stripped+        then do+          let rest = T.strip (T.drop 2 stripped)+          (right, rest') <- parseAndExpr rest+          parseOrRest (ExprOr left right) rest'+        else Right (left, input)++parseAndExpr :: Parser Expr+parseAndExpr input = do+  (left, rest) <- parseNotExpr input+  parseAndRest left rest++parseAndRest :: Expr -> Parser Expr+parseAndRest left input =+  let stripped = T.strip input+   in if "&&" `T.isPrefixOf` stripped+        then do+          let rest = T.strip (T.drop 2 stripped)+          (right, rest') <- parseNotExpr rest+          parseAndRest (ExprAnd left right) rest'+        else Right (left, input)++parseNotExpr :: Parser Expr+parseNotExpr input =+  let stripped = T.strip input+   in if "!" `T.isPrefixOf` stripped+        then do+          let rest = T.drop 1 stripped+          (e, rest') <- parseNotExpr rest+          Right (ExprNot e, rest')+        else parseAtom stripped++parseAtom :: Parser Expr+parseAtom input =+  let stripped = T.strip input+   in case () of+        _+          | T.null stripped -> Left "unexpected end of input"+          | "true" `T.isPrefixOf` stripped && isAtomEnd (T.drop 4 stripped) ->+              Right (ExprLit True, T.drop 4 stripped)+          | "false" `T.isPrefixOf` stripped && isAtomEnd (T.drop 5 stripped) ->+              Right (ExprLit False, T.drop 5 stripped)+          | "IsSet" `T.isPrefixOf` stripped && isWhitespace (T.drop 5 stripped) -> do+              let rest = T.strip (T.drop 5 stripped)+              (name, rest') <- parseVarName rest+              Right (ExprIsSet (VarName name), rest')+          | "Eq" `T.isPrefixOf` stripped && isWhitespace (T.drop 2 stripped) -> do+              let rest = T.strip (T.drop 2 stripped)+              (name, rest') <- parseVarName rest+              let rest'' = T.strip rest'+              (value, rest''') <- parseValue rest''+              Right (ExprEq (VarName name) value, rest''')+          | T.head stripped == '(' -> do+              let rest = T.strip (T.drop 1 stripped)+              (e, rest') <- parseOrExpr rest+              let rest'' = T.strip rest'+              if not (T.null rest'') && T.head rest'' == ')'+                then Right (e, T.drop 1 rest'')+                else Left "expected closing parenthesis"+          | otherwise -> Left ("unexpected token: " <> T.take 20 stripped)++-- | Check if the character after a keyword is a valid separator (not a varname char).+isAtomEnd :: Text -> Bool+isAtomEnd t = T.null t || not (isVarNameChar (T.head t))++isWhitespace :: Text -> Bool+isWhitespace t = not (T.null t) && T.head t == ' '++parseVarName :: Parser Text+parseVarName input+  | T.null input = Left "expected variable name"+  | not (isVarNameStart (T.head input)) = Left ("expected variable name, got: " <> T.take 10 input)+  | otherwise =+      let (name, rest) = T.span isVarNameChar input+       in Right (name, rest)++isVarNameStart :: Char -> Bool+isVarNameStart c = (c >= 'a' && c <= 'z') || (c >= 'A' && c <= 'Z')++isVarNameChar :: Char -> Bool+isVarNameChar c =+  (c >= 'a' && c <= 'z')+    || (c >= 'A' && c <= 'Z')+    || (c >= '0' && c <= '9')+    || c == '.'+    || c == '_'+    || c == '-'++parseValue :: Parser VarValue+parseValue input+  | T.null input = Left "expected value"+  | T.head input == '"' = parseQuotedString (T.drop 1 input)+  | otherwise = parseBareWord input++parseQuotedString :: Parser VarValue+parseQuotedString input =+  case T.breakOn "\"" input of+    (content, rest)+      | T.null rest -> Left "unterminated quoted string"+      | otherwise -> Right (VText content, T.drop 1 rest)++parseBareWord :: Parser VarValue+parseBareWord input =+  let (word, rest) = T.break (\c -> c == ' ' || c == ')' || c == '&' || c == '|') input+   in if T.null word+        then Left "expected value"+        else Right (classifyBareWord word, rest)+  where+    classifyBareWord "true" = VBool True+    classifyBareWord "false" = VBool False+    classifyBareWord w+      | isIntLiteral w = VInt (read (T.unpack w))+      | otherwise = VText w++-- | Whether a bareword is an integer literal: all digits, with an optional+-- leading minus sign and at least one digit. Such barewords are classified as+-- 'VInt' so an @Eq <int-var> N@ comparison matches a resolved 'VInt' value+-- (there is otherwise no surface syntax that produces an integer literal).+isIntLiteral :: Text -> Bool+isIntLiteral w =+  case T.uncons w of+    Just ('-', rest) -> not (T.null rest) && T.all isDigit rest+    _ -> not (T.null w) && T.all isDigit w
+ src/Seihou/Core/Install.hs view
@@ -0,0 +1,17 @@+module Seihou.Core.Install+  ( parseModuleName,+  )+where++import Data.Text qualified as T+import Seihou.Prelude++-- | Parse a module name from a git URL by extracting the last path segment+-- and stripping a trailing .git extension.+parseModuleName :: Text -> String+parseModuleName url =+  let stripped = T.stripSuffix ".git" url+      base = maybe url id stripped+      segments = T.splitOn "/" base+      lastSeg = if null segments then base else last segments+   in T.unpack lastSeg
+ src/Seihou/Core/Migration.hs view
@@ -0,0 +1,191 @@+module Seihou.Core.Migration+  ( -- * Author-declared migrations+    Migration (..),+    MigrationOp (..),++    -- * Migration planning+    MigrationPlan (..),+    MigrationPlanError (..),+    planMigrationChain,+  )+where++import Data.List (sortOn)+import GHC.Generics (Generic)+import Seihou.Core.Version (Version, parseVersion)+import Seihou.Prelude++-- | A single filesystem operation declared by a migration.+--+-- The variants mirror the Dhall union @schema/MigrationOp.dhall@ exactly:+--+--   * 'MoveFile'   — rename a tracked file. The migration engine rewrites+--     the manifest's @files@ map key from @src@ to @dest@.+--   * 'MoveDir'    — rename a directory. Every manifest @files@ entry whose+--     path starts with @src/@ has its key rewritten with the @dest/@ prefix.+--   * 'DeleteFile' — remove a tracked file from disk and drop it from the+--     manifest.+--   * 'DeleteDir'  — remove a directory recursively and drop every manifest+--     entry under that prefix.+--   * 'RunCommand' — execute a shell command. The manifest is not rewritten+--     by this op; if the command moves files, the migration author is+--     responsible for following it with explicit move/delete ops.+data MigrationOp+  = MoveFile {src :: FilePath, dest :: FilePath}+  | MoveDir {src :: FilePath, dest :: FilePath}+  | DeleteFile {path :: FilePath}+  | DeleteDir {path :: FilePath}+  | RunCommand {run :: Text, workDir :: Maybe FilePath}+  deriving stock (Eq, Show, Generic)++-- | A migration that moves a project from module version @from@ to module+-- version @to@. The 'ops' list is applied in declaration order.+data Migration = Migration+  { from :: Text,+    to :: Text,+    ops :: [MigrationOp]+  }+  deriving stock (Eq, Show, Generic)++-- ----------------------------------------------------------------------------+-- Pure planner — gap-tolerant version-window walker+--+-- The planner is the bridge between the unsorted list of author-declared+-- migrations on a 'Module' and the ordered sequence that the migration+-- engine actually executes. It is a pure function: no IO, no filesystem,+-- no manifest. The @moduleName@ parameter is the rendered module name+-- (a 'Text', not 'Seihou.Core.Types.ModuleName') so this module can stay+-- self-contained and avoid a circular dependency with @Types@ (which+-- imports 'Migration' for the @migrations@ field on @Module@). The CLI+-- handler unwraps the 'ModuleName' newtype before calling.+--+-- The planner's contract is simple: given an installed manifest version+-- and a target version, apply every declared migration @m@ such that+-- @installed ≤ m.from@ and @m.to ≤ target@, in ascending @from@ order,+-- advancing a cursor as you go (skipping any edge whose @from@ has+-- fallen behind the cursor). After all applicable edges have been+-- collected, the manifest's recorded version always advances to+-- @target@, even when no migration applies (a "pure version bump").+-- ----------------------------------------------------------------------------++-- | The planner result for a non-trivial @installed → target@ request.+--+-- The plan carries the module name for rendering, the start and end+-- versions of the user-visible "X → Y" header, and the ordered list of+-- migrations that will run. A plan with @planSteps == []@ means the+-- manifest will advance from @planFrom@ to @planTo@ without running+-- any migration ops (a pure version bump).+data MigrationPlan = MigrationPlan+  { planModule :: Text,+    -- | Installed (manifest) version at the start.+    planFrom :: Version,+    -- | Target version. The manifest will land here after the plan+    -- runs, regardless of whether any of the declared migrations+    -- bridge every gap inside @[planFrom, planTo]@.+    planTo :: Version,+    -- | The migrations that actually apply, in ascending @from@+    -- order. May be empty.+    planSteps :: [Migration]+  }+  deriving stock (Eq, Show, Generic)++-- | All the ways planning can fail. Each carries enough information to+-- write a useful error message at the CLI layer.+data MigrationPlanError+  = -- | A 'Migration' had a 'from' or 'to' string that didn't parse.+    -- Carries the offending string verbatim.+    MigrationVersionUnparseable Text+  | -- | Refusing to plan a downgrade. @installed → target@ where @target@+    -- compares strictly less than @installed@.+    MigrationDowngradeNotSupported Version Version+  | -- | Two migrations declare the same 'from' version, so the planner+    -- can't unambiguously pick a successor. Args: the duplicated 'from'+    -- and one of the conflicting 'to' versions.+    MigrationDuplicateEdge Version Version+  deriving stock (Eq, Show, Generic)++-- | Compute the migration plan that spans installed → target.+--+-- Returns:+--+--   * @Right Nothing@ — installed and target are equal; no work to do.+--   * @Right (Just plan)@ — the plan carries every migration whose+--     version range falls inside @[installed, target]@, plus the+--     installed and target versions for downstream rendering and+--     manifest-advance logic. The list may be empty (a pure version+--     bump where no migration applies); the manifest still advances+--     to @target@ in that case.+--   * @Left e@ — planning failed; the error variant explains why.+--     Author-side mistakes (duplicate edge, unparseable version) and+--     downgrades are still hard errors. Partial coverage is not, and+--     overshoots are silently skipped.+--+-- Algorithm: parse every declared migration's @from@/@to@ into+-- 'Version' values, reject duplicate @from@s, sort the remaining edges+-- by @from@ ascending, then walk the sorted list with a cursor. Each+-- edge is either picked (and the cursor advances to its @to@), skipped+-- because its @from@ has fallen behind the cursor (already covered by+-- an earlier picked edge), skipped because its @to@ overshoots the+-- target (the user hasn't asked to go that far), or terminates the+-- walk because its @from@ has reached or exceeded the target (no+-- subsequent edge in the sorted list can contribute either).+planMigrationChain ::+  -- | Module name (already rendered to text)+  Text ->+  -- | All declared migrations on the module+  [Migration] ->+  -- | Installed version+  Version ->+  -- | Target version+  Version ->+  Either MigrationPlanError (Maybe MigrationPlan)+planMigrationChain modName migrations installed target+  | installed == target = Right Nothing+  | target < installed =+      Left (MigrationDowngradeNotSupported installed target)+  | otherwise = do+      parsed <- traverse parseEdges migrations+      checkDuplicates parsed+      let sorted = sortOn (\(_, f, _) -> f) parsed+          steps = pickInWindow installed target sorted+      Right+        ( Just+            MigrationPlan+              { planModule = modName,+                planFrom = installed,+                planTo = target,+                planSteps = steps+              }+        )+  where+    -- Parse a migration's from/to fields into Version values.+    parseEdges m = do+      fv <- parseVersionE m.from+      tv <- parseVersionE m.to+      Right (m, fv, tv)++    parseVersionE t =+      case parseVersion t of+        Just v -> Right v+        Nothing -> Left (MigrationVersionUnparseable t)++    -- Detect two migrations declaring the same `from` version.+    checkDuplicates [] = Right ()+    checkDuplicates ((_, f, t) : rest) =+      case [t' | (_, f', t') <- rest, f' == f] of+        (t' : _) -> Left (MigrationDuplicateEdge f t')+        [] -> checkDuplicates rest++    -- Walk the sorted edge list collecting in-window migrations.+    -- The list is sorted by `from` ascending, so once an edge has+    -- `from >= end` no later edge can contribute either. An edge with+    -- `from < cursor` is already-covered (or precedes the manifest)+    -- and is skipped. An edge with `to > end` overshoots the target+    -- and is silently skipped — a future invocation with a higher+    -- target will pick it up.+    pickInWindow _cursor _end [] = []+    pickInWindow cursor end ((m, f, t) : rest)+      | f < cursor = pickInWindow cursor end rest+      | f >= end = []+      | t > end = pickInWindow cursor end rest+      | otherwise = m : pickInWindow t end rest
+ src/Seihou/Core/Module.hs view
@@ -0,0 +1,565 @@+module Seihou.Core.Module+  ( discoverModule,+    discoverBlueprint,+    discoverAgentPrompt,+    discoverRunnable,+    defaultSearchPaths,+    validateModule,+    loadModule,+    discoverAllModules,+    discoverAllRunnables,+    DiscoveredModule (..),+    DiscoveredRunnable (..),+    RunnableKind (..),+    ModuleSource (..),++    -- * Individual check functions (for structured reports)+    checkNameFormat,+    checkVersionPresent,+    checkUniqueVars,+    checkPromptRefs,+    checkFileExistence,+    checkExportRefs,+    checkDependencyNames,+    checkDependencyVarBindings,+    checkSafeDestinations,+    checkDestVarRefs,+    checkCommandSafety,+    isValidModuleName,+    extractPlaceholders,+    validateProjectRelativePath,+  )+where++import Data.Map.Strict qualified as Map+import Data.Set qualified as Set+import Data.Text qualified as T+import GHC.Generics (Generic)+import Seihou.Core.Path (validateProjectRelativePath)+import Seihou.Core.Types+import Seihou.Dhall.Eval (evalAgentPromptFromFile, evalBlueprintFromFile, evalModuleFromFile, evalRecipeFromFile)+import Seihou.Prelude+import System.Directory (XdgDirectory (..), doesDirectoryExist, doesFileExist, getCurrentDirectory, getXdgDirectory, listDirectory)++-- | Search for a module by name in the given directories.+-- Returns the path to the directory containing @module.dhall@, or+-- 'ModuleNotFound' listing the directories that were searched.+discoverModule :: [FilePath] -> ModuleName -> IO (Either ModuleLoadError FilePath)+discoverModule searchPaths name = go searchPaths+  where+    nameStr = T.unpack name.unModuleName+    go [] = pure $ Left (ModuleNotFound name searchPaths)+    go (dir : rest) = do+      let candidate = dir </> nameStr+      let dhallFile = candidate </> "module.dhall"+      exists <- doesFileExist dhallFile+      if exists+        then pure (Right candidate)+        else go rest++-- | Search for a runnable (module, recipe, blueprint, or prompt) by name in the+-- given directories. For each search path, checks @module.dhall@ first+-- (returning 'RunnableModule'), then @recipe.dhall@+-- (returning 'RunnableRecipe'), then @blueprint.dhall@+-- (returning 'RunnableBlueprint'), then @prompt.dhall@+-- (returning 'RunnableAgentPrompt'). Within a single candidate directory+-- the priority is module > recipe > blueprint > prompt, so a stray+-- @module.dhall@ next to a @blueprint.dhall@ silently surfaces the+-- module — the more specific, deterministic artifact. Returns+-- 'ModuleNotFound' if none is found in any search path.+discoverRunnable :: [FilePath] -> ModuleName -> IO (Either ModuleLoadError Runnable)+discoverRunnable searchPaths name = go searchPaths+  where+    nameStr = T.unpack name.unModuleName+    go [] = pure $ Left (ModuleNotFound name searchPaths)+    go (dir : rest) = do+      let candidate = dir </> nameStr+          moduleDhall = candidate </> "module.dhall"+          recipeDhall = candidate </> "recipe.dhall"+          blueprintDhall = candidate </> "blueprint.dhall"+          promptDhall = candidate </> "prompt.dhall"+      isModule <- doesFileExist moduleDhall+      if isModule+        then do+          result <- evalModuleFromFile moduleDhall+          case result of+            Left err -> pure (Left err)+            Right m -> pure (Right (RunnableModule m candidate))+        else do+          isRecipe <- doesFileExist recipeDhall+          if isRecipe+            then do+              result <- evalRecipeFromFile recipeDhall+              case result of+                Left err -> pure (Left err)+                Right r -> pure (Right (RunnableRecipe r candidate))+            else do+              isBlueprint <- doesFileExist blueprintDhall+              if isBlueprint+                then do+                  result <- evalBlueprintFromFile blueprintDhall+                  case result of+                    Left err -> pure (Left err)+                    Right b -> pure (Right (RunnableBlueprint b candidate))+                else do+                  isPrompt <- doesFileExist promptDhall+                  if isPrompt+                    then do+                      result <- evalAgentPromptFromFile promptDhall+                      case result of+                        Left err -> pure (Left err)+                        Right p -> pure (Right (RunnableAgentPrompt p candidate))+                    else go rest++-- | Search for a blueprint by name in the given directories. Returns+-- the path to the directory containing @blueprint.dhall@, or+-- 'ModuleNotFound' listing the directories that were searched. Mirrors+-- 'discoverModule' for callers that only care about discovering a+-- blueprint by name.+discoverBlueprint :: [FilePath] -> ModuleName -> IO (Either ModuleLoadError FilePath)+discoverBlueprint searchPaths name = go searchPaths+  where+    nameStr = T.unpack name.unModuleName+    go [] = pure $ Left (ModuleNotFound name searchPaths)+    go (dir : rest) = do+      let candidate = dir </> nameStr+      let dhallFile = candidate </> "blueprint.dhall"+      exists <- doesFileExist dhallFile+      if exists+        then pure (Right candidate)+        else go rest++-- | Search for an agent prompt by name in the given directories. Returns+-- the path to the directory containing @prompt.dhall@, or 'ModuleNotFound'+-- listing the directories that were searched.+discoverAgentPrompt :: [FilePath] -> ModuleName -> IO (Either ModuleLoadError FilePath)+discoverAgentPrompt searchPaths name = go searchPaths+  where+    nameStr = T.unpack name.unModuleName+    go [] = pure $ Left (ModuleNotFound name searchPaths)+    go (dir : rest) = do+      let candidate = dir </> nameStr+      let dhallFile = candidate </> "prompt.dhall"+      exists <- doesFileExist dhallFile+      if exists+        then pure (Right candidate)+        else go rest++-- | The three standard module search paths, in priority order:+-- 1. @.seihou/modules/@ relative to the current directory+-- 2. @~/.config/seihou/modules/@+-- 3. @~/.config/seihou/installed/@+defaultSearchPaths :: IO [FilePath]+defaultSearchPaths = do+  cwd <- getCurrentDirectory+  xdgConfig <- getXdgDirectory XdgConfig "seihou"+  pure+    [ cwd </> ".seihou" </> "modules",+      xdgConfig </> "modules",+      xdgConfig </> "installed"+    ]++-- | Validate a decoded 'Module' against the nine validation rules.+-- The 'FilePath' is the module's base directory (containing @module.dhall@).+-- Returns 'Right' with the module if all rules pass, or 'Left' with a+-- 'ValidationError' listing all violations.+validateModule :: FilePath -> Module -> IO (Either ModuleLoadError Module)+validateModule baseDir m = do+  fileErrors <- checkFileExistence baseDir m+  let pureErrors =+        checkNameFormat m+          <> checkVersionPresent m+          <> checkUniqueVars m+          <> checkPromptRefs m+          <> checkExportRefs m+          <> checkDependencyNames m+          <> checkDependencyVarBindings m+          <> checkSafeDestinations m+          <> checkDestVarRefs m+          <> checkCommandSafety m+      allErrors = pureErrors <> fileErrors+  pure $+    if null allErrors+      then Right m+      else Left (ValidationError m.name allErrors)++-- Rule 1: Module name must be non-empty and match [a-z][a-z0-9-]*+checkNameFormat :: Module -> [Text]+checkNameFormat m =+  let n = m.name.unModuleName+   in if T.null n || not (isValidModuleName n)+        then ["module name must match [a-z][a-z0-9-]*, got: " <> n]+        else []++isValidModuleName :: Text -> Bool+isValidModuleName t = case T.uncons t of+  Nothing -> False+  Just (c, rest) ->+    (c >= 'a' && c <= 'z')+      && T.all (\ch -> (ch >= 'a' && ch <= 'z') || (ch >= '0' && ch <= '9') || ch == '-') rest++-- Rule 1b: Module must declare a version+checkVersionPresent :: Module -> [Text]+checkVersionPresent m = case m.version of+  Nothing -> ["module must declare a version"]+  Just v+    | T.null (T.strip v) -> ["module must declare a version"]+    | otherwise -> []++-- Rule 2: All variable names must be unique+checkUniqueVars :: Module -> [Text]+checkUniqueVars m =+  let names = map (\d -> d.name.unVarName) m.vars+   in map (\n -> "duplicate variable name: " <> n) (findDupes Set.empty Set.empty names)++findDupes :: Set.Set Text -> Set.Set Text -> [Text] -> [Text]+findDupes _ _ [] = []+findDupes seen reported (x : xs)+  | Set.member x seen && not (Set.member x reported) = x : findDupes seen (Set.insert x reported) xs+  | otherwise = findDupes (Set.insert x seen) reported xs++-- Rule 3: Every prompt must reference a declared variable+checkPromptRefs :: Module -> [Text]+checkPromptRefs m =+  let varNames = Set.fromList (map (.name) m.vars)+   in concatMap+        ( \p ->+            if Set.member p.var varNames+              then []+              else ["prompt references undeclared variable: " <> p.var.unVarName]+        )+        m.prompts++-- Rule 4: Every step source file must exist in the module's files/ directory+checkFileExistence :: FilePath -> Module -> IO [Text]+checkFileExistence baseDir m =+  concat+    <$> mapM+      ( \s -> do+          let p = baseDir </> "files" </> s.src+          exists <- doesFileExist p+          pure $+            if exists+              then []+              else ["step source file not found: " <> T.pack s.src]+      )+      m.steps++-- Rule 5: Every export must reference a declared variable+checkExportRefs :: Module -> [Text]+checkExportRefs m =+  let varNames = Set.fromList (map (.name) m.vars)+   in concatMap+        ( \e ->+            if Set.member e.var varNames+              then []+              else ["export references undeclared variable: " <> e.var.unVarName]+        )+        m.exports++-- Rule 6: Every dependency name must be well-formed+checkDependencyNames :: Module -> [Text]+checkDependencyNames m =+  concatMap+    ( \dep ->+        let n = dep.depModule.unModuleName+         in if isValidModuleName n+              then []+              else ["invalid dependency name: " <> n]+    )+    m.dependencies++-- Rule 6b: Dependency var binding names must be non-empty+checkDependencyVarBindings :: Module -> [Text]+checkDependencyVarBindings m =+  concatMap+    ( \dep ->+        concatMap+          ( \(VarName vn) ->+              if T.null vn+                then ["dependency '" <> dep.depModule.unModuleName <> "' has empty var binding name"]+                else []+          )+          (Map.keys dep.depVars)+    )+    m.dependencies++-- Rule 7: Every step destination must be a safe relative path+checkSafeDestinations :: Module -> [Text]+checkSafeDestinations m = concatMap checkDest m.steps+  where+    checkDest s =+      case validateProjectRelativePath s.dest of+        Left err -> ["step destination " <> err]+        Right _ -> []++-- Rule 8: Variables referenced in step dest placeholders must be declared+checkDestVarRefs :: Module -> [Text]+checkDestVarRefs m =+  let varNames = Set.fromList (map (\d -> d.name.unVarName) m.vars)+   in concatMap (checkStep varNames) m.steps+  where+    checkStep varNames s =+      [ "step destination references undeclared variable: " <> ref+      | ref <- extractPlaceholders s.dest,+        not (Set.member ref varNames)+      ]++-- Rule 9: Command text must be non-empty and workDir must be safe+checkCommandSafety :: Module -> [Text]+checkCommandSafety m = concatMap checkCmd m.commands+  where+    checkCmd c = checkEmptyRun c <> checkWorkDir c.workDir++    checkEmptyRun c+      | T.null (T.strip c.run) = ["command text must not be empty"]+      | otherwise = []++    checkWorkDir Nothing = []+    checkWorkDir (Just wd) =+      case validateProjectRelativePath wd of+        Left err -> ["command workDir " <> err]+        Right _ -> []++-- | Extract placeholder variable references from a text like @"src/{{project.name}}/Main.hs"@.+extractPlaceholders :: Text -> [Text]+extractPlaceholders t = case T.breakOn "{{" t of+  (_, rest)+    | T.null rest -> []+    | otherwise ->+        let afterOpen = T.drop 2 rest+         in case T.breakOn "}}" afterOpen of+              (ref, rest')+                | T.null rest' -> []+                | otherwise -> T.strip ref : extractPlaceholders (T.drop 2 rest')++-- | Load a module by name: discover, evaluate, decode, and validate.+loadModule :: [FilePath] -> ModuleName -> IO (Either ModuleLoadError Module)+loadModule searchPaths name = do+  discovered <- discoverModule searchPaths name+  case discovered of+    Left err -> pure (Left err)+    Right moduleDir -> do+      let dhallFile = moduleDir </> "module.dhall"+      decoded <- evalModuleFromFile dhallFile+      case decoded of+        Left err -> pure (Left err)+        Right m -> validateModule moduleDir m++-- | Which search path category a module was found in.+data ModuleSource = SourceProject | SourceUser | SourceInstalled+  deriving stock (Eq, Show, Generic)++-- | A module discovered during enumeration, with its load result and source.+data DiscoveredModule = DiscoveredModule+  { discoveredResult :: Either ModuleLoadError Module,+    discoveredSource :: ModuleSource,+    discoveredDir :: FilePath+  }+  deriving stock (Show)++-- | Enumerate all modules across the given search paths.+-- The search paths must be in the same order as 'defaultSearchPaths':+-- project-local, user, installed. Each subdirectory containing a+-- @module.dhall@ file is loaded; failures are captured in 'discoveredResult'.+discoverAllModules :: [FilePath] -> IO [DiscoveredModule]+discoverAllModules searchPaths = do+  let tagged = zip searchPaths (sources ++ repeat SourceInstalled)+  concat <$> mapM (uncurry scanPath) tagged+  where+    sources = [SourceProject, SourceUser, SourceInstalled]++    scanPath :: FilePath -> ModuleSource -> IO [DiscoveredModule]+    scanPath dir src = do+      exists <- doesDirectoryExist dir+      if not exists+        then pure []+        else do+          entries <- listDirectory dir+          candidates <- filterM (isModuleDir dir) entries+          mapM (loadOne dir src) candidates++    isModuleDir :: FilePath -> FilePath -> IO Bool+    isModuleDir parent entry = do+      let candidate = parent </> entry </> "module.dhall"+      doesFileExist candidate++    filterM :: (a -> IO Bool) -> [a] -> IO [a]+    filterM _ [] = pure []+    filterM p (x : xs) = do+      keep <- p x+      rest <- filterM p xs+      pure (if keep then x : rest else rest)++    loadOne :: FilePath -> ModuleSource -> FilePath -> IO DiscoveredModule+    loadOne dir src entry = do+      let moduleDir = dir </> entry+          dhallFile = moduleDir </> "module.dhall"+      decoded <- evalModuleFromFile dhallFile+      result <- case decoded of+        Left err -> pure (Left err)+        Right m -> validateModule moduleDir m+      pure DiscoveredModule {discoveredResult = result, discoveredSource = src, discoveredDir = moduleDir}++-- | Whether a discovered item is a module, recipe, blueprint, or prompt.+data RunnableKind = KindModule | KindRecipe | KindBlueprint | KindPrompt+  deriving stock (Eq, Show, Generic)++-- | A runnable discovered during enumeration, with its load result, kind, and source.+data DiscoveredRunnable = DiscoveredRunnable+  { drName :: Text,+    drDescription :: Maybe Text,+    drKind :: RunnableKind,+    drSource :: ModuleSource,+    drDir :: FilePath,+    drIsError :: Bool,+    drError :: Maybe Text+  }+  deriving stock (Show)++-- | Enumerate all modules, recipes, blueprints, and prompts across the given search paths.+-- Returns a unified list of discovered items, each tagged with its kind.+discoverAllRunnables :: [FilePath] -> IO [DiscoveredRunnable]+discoverAllRunnables searchPaths = do+  let tagged = zip searchPaths (sources ++ repeat SourceInstalled)+  concat <$> mapM (uncurry scanRunnablePath) tagged+  where+    sources = [SourceProject, SourceUser, SourceInstalled]++    scanRunnablePath :: FilePath -> ModuleSource -> IO [DiscoveredRunnable]+    scanRunnablePath dir src = do+      exists <- doesDirectoryExist dir+      if not exists+        then pure []+        else do+          entries <- listDirectory dir+          concat <$> mapM (loadRunnable dir src) entries++    loadRunnable :: FilePath -> ModuleSource -> FilePath -> IO [DiscoveredRunnable]+    loadRunnable dir src entry = do+      let entryDir = dir </> entry+          moduleDhall = entryDir </> "module.dhall"+          recipeDhall = entryDir </> "recipe.dhall"+          blueprintDhall = entryDir </> "blueprint.dhall"+          promptDhall = entryDir </> "prompt.dhall"+      isModule <- doesFileExist moduleDhall+      isRecipe <- doesFileExist recipeDhall+      isBlueprint <- doesFileExist blueprintDhall+      isPrompt <- doesFileExist promptDhall+      if isModule+        then do+          decoded <- evalModuleFromFile moduleDhall+          pure+            [ case decoded of+                Left err ->+                  DiscoveredRunnable+                    { drName = T.pack entry,+                      drDescription = Nothing,+                      drKind = KindModule,+                      drSource = src,+                      drDir = entryDir,+                      drIsError = True,+                      drError = Just (briefLoadError err)+                    }+                Right m ->+                  DiscoveredRunnable+                    { drName = m.name.unModuleName,+                      drDescription = m.description,+                      drKind = KindModule,+                      drSource = src,+                      drDir = entryDir,+                      drIsError = False,+                      drError = Nothing+                    }+            ]+        else+          if isRecipe+            then do+              decoded <- evalRecipeFromFile recipeDhall+              pure+                [ case decoded of+                    Left err ->+                      DiscoveredRunnable+                        { drName = T.pack entry,+                          drDescription = Nothing,+                          drKind = KindRecipe,+                          drSource = src,+                          drDir = entryDir,+                          drIsError = True,+                          drError = Just (briefLoadError err)+                        }+                    Right r ->+                      DiscoveredRunnable+                        { drName = r.name.unRecipeName,+                          drDescription = r.description,+                          drKind = KindRecipe,+                          drSource = src,+                          drDir = entryDir,+                          drIsError = False,+                          drError = Nothing+                        }+                ]+            else+              if isBlueprint+                then do+                  decoded <- evalBlueprintFromFile blueprintDhall+                  pure+                    [ case decoded of+                        Left err ->+                          DiscoveredRunnable+                            { drName = T.pack entry,+                              drDescription = Nothing,+                              drKind = KindBlueprint,+                              drSource = src,+                              drDir = entryDir,+                              drIsError = True,+                              drError = Just (briefLoadError err)+                            }+                        Right b ->+                          DiscoveredRunnable+                            { drName = b.name.unModuleName,+                              drDescription = b.description,+                              drKind = KindBlueprint,+                              drSource = src,+                              drDir = entryDir,+                              drIsError = False,+                              drError = Nothing+                            }+                    ]+                else+                  if isPrompt+                    then do+                      decoded <- evalAgentPromptFromFile promptDhall+                      pure+                        [ case decoded of+                            Left err ->+                              DiscoveredRunnable+                                { drName = T.pack entry,+                                  drDescription = Nothing,+                                  drKind = KindPrompt,+                                  drSource = src,+                                  drDir = entryDir,+                                  drIsError = True,+                                  drError = Just (briefLoadError err)+                                }+                            Right p ->+                              DiscoveredRunnable+                                { drName = p.name.unModuleName,+                                  drDescription = p.description,+                                  drKind = KindPrompt,+                                  drSource = src,+                                  drDir = entryDir,+                                  drIsError = False,+                                  drError = Nothing+                                }+                        ]+                    else pure []++    briefLoadError :: ModuleLoadError -> Text+    briefLoadError (DhallEvalError _ _) = "Dhall evaluation failed"+    briefLoadError (DhallDecodeError _ _) = "Dhall decode failed"+    briefLoadError (ValidationError _ _) = "validation failed"+    briefLoadError (ModuleNotFound _ _) = "not found"+    briefLoadError (MissingSourceFile _ _) = "missing source file"+    briefLoadError (CircularDependency _) = "circular dependency"+    briefLoadError (RegistryEvalError _ _) = "registry eval failed"
+ src/Seihou/Core/Path.hs view
@@ -0,0 +1,29 @@+module Seihou.Core.Path+  ( validateProjectRelativePath,+  )+where++import Data.Text qualified as T+import Seihou.Prelude+import System.FilePath qualified as FilePath+import System.FilePath.Windows qualified as WindowsPath++-- | Validate that a path stays within a project root when later appended to it.+-- The path must be non-empty, relative on POSIX and Windows, and must not+-- contain a parent-directory segment.+validateProjectRelativePath :: Text -> Either Text FilePath+validateProjectRelativePath rawPath+  | T.null path = Left "path must not be empty"+  | FilePath.isAbsolute pathString || WindowsPath.isAbsolute pathString =+      Left ("path must be relative: " <> path)+  | any (== "..") (pathSegments path) =+      Left ("path must not contain '..' segment: " <> path)+  | otherwise = Right pathString+  where+    path = T.strip rawPath+    pathString = T.unpack path++pathSegments :: Text -> [Text]+pathSegments =+  filter (not . T.null)+    . T.split (\c -> c == '/' || c == '\\')
+ src/Seihou/Core/Recipe.hs view
@@ -0,0 +1,78 @@+module Seihou.Core.Recipe+  ( validateRecipe,+  )+where++import Data.Map.Strict qualified as Map+import Data.Set qualified as Set+import Data.Text (Text)+import Data.Text qualified as T+import Seihou.Core.Module (isValidModuleName)+import Seihou.Core.Types++-- | Validate a 'Recipe' against recipe-specific rules.+-- Returns 'Right' with the recipe if all rules pass, or 'Left' with a+-- list of all violations.+--+-- Validation rules:+--   1. Name matches @[a-z][a-z0-9-]*@+--   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.-]*@+validateRecipe :: Recipe -> Either [Text] Recipe+validateRecipe recipe =+  let errs =+        checkRecipeNameFormat recipe+          <> checkNonEmptyModules recipe+          <> checkNoDuplicateModules recipe+          <> checkVarBindingNames recipe+   in if null errs+        then Right recipe+        else Left errs++-- Rule 1: Recipe name must match [a-z][a-z0-9-]*+checkRecipeNameFormat :: Recipe -> [Text]+checkRecipeNameFormat recipe =+  let n = recipe.name.unRecipeName+   in if T.null n || not (isValidModuleName n)+        then ["recipe name must match [a-z][a-z0-9-]*, got: " <> n]+        else []++-- Rule 2: At least one module must be listed+checkNonEmptyModules :: Recipe -> [Text]+checkNonEmptyModules recipe+  | null recipe.modules = ["recipe must list at least one module"]+  | otherwise = []++-- Rule 3: No duplicate module names+checkNoDuplicateModules :: Recipe -> [Text]+checkNoDuplicateModules recipe =+  let names = map (.depModule.unModuleName) recipe.modules+   in map (\n -> "duplicate module in recipe: " <> n) (findDupes Set.empty Set.empty names)++findDupes :: Set.Set Text -> Set.Set Text -> [Text] -> [Text]+findDupes _ _ [] = []+findDupes seen reported (x : xs)+  | Set.member x seen && not (Set.member x reported) = x : findDupes seen (Set.insert x reported) xs+  | otherwise = findDupes (Set.insert x seen) reported xs++-- Rule 4: Variable binding names must match [a-z][a-z0-9.-]*+checkVarBindingNames :: Recipe -> [Text]+checkVarBindingNames recipe =+  concatMap checkDep recipe.modules+  where+    checkDep dep =+      concatMap+        ( \(VarName vn) ->+            if isValidVarBindingName vn+              then []+              else ["invalid var binding name '" <> vn <> "' in module '" <> dep.depModule.unModuleName <> "'"]+        )+        (Map.keys dep.depVars)++    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
+ src/Seihou/Core/Registry.hs view
@@ -0,0 +1,538 @@+module Seihou.Core.Registry+  ( Registry (..),+    RegistryEntry (..),+    RepoContents (..),+    discoverRepoContents,+    validateRegistry,+    renderRegistryDhall,+    EntryKind (..),+    SyncStatus (..),+    SyncDiff (..),+    SyncReport (..),+    computeRegistrySync,+    formatDriftWarning,+    RegistryValidationIssue (..),+    RegistryValidationReport (..),+    reportHasIssues,+    validateRegistryFull,+    formatValidationIssue,+  )+where++import Data.Text qualified as T+import GHC.Generics (Generic)+import Seihou.Core.Types (ModuleLoadError, ModuleName (..))+import Seihou.Prelude+import System.Directory (doesFileExist)++-- | A single module listing within a registry.+data RegistryEntry = RegistryEntry+  { name :: ModuleName,+    version :: Maybe Text,+    path :: FilePath,+    description :: Maybe Text,+    tags :: [Text]+  }+  deriving stock (Eq, Show, Generic)++-- | Registry metadata for a multi-module repository.+-- Declared in @seihou-registry.dhall@ at the repo root.+data Registry = Registry+  { repoName :: Text,+    repoDescription :: Maybe Text,+    modules :: [RegistryEntry],+    recipes :: [RegistryEntry],+    blueprints :: [RegistryEntry],+    prompts :: [RegistryEntry]+  }+  deriving stock (Eq, Show, Generic)++-- | What a cloned repository contains.+data RepoContents+  = -- | Repo root has @module.dhall@ (single module)+    SingleModule FilePath+  | -- | Repo root has @recipe.dhall@ (single recipe)+    SingleRecipe FilePath+  | -- | Repo root has @blueprint.dhall@ (single blueprint)+    SingleBlueprint FilePath+  | -- | Repo root has @prompt.dhall@ (single prompt)+    SinglePrompt FilePath+  | -- | Repo root has @seihou-registry.dhall@+    MultiModule Registry+  | -- | Neither found+    EmptyRepo+  deriving stock (Show)++-- | Examine a cloned repo root and determine what it contains.+-- The first argument is a function that evaluates a registry Dhall file,+-- injected to avoid a circular module dependency with @Seihou.Dhall.Eval@.+discoverRepoContents ::+  (FilePath -> IO (Either ModuleLoadError Registry)) ->+  FilePath ->+  IO RepoContents+discoverRepoContents evalRegistry repoRoot = do+  let registryFile = repoRoot </> "seihou-registry.dhall"+  hasRegistry <- doesFileExist registryFile+  if hasRegistry+    then do+      result <- evalRegistry registryFile+      case result of+        Right reg -> pure (MultiModule reg)+        Left _ -> probeSingleArtifact repoRoot+    else probeSingleArtifact repoRoot++-- | Probe for a single-artifact repo at @repoRoot@. Precedence:+-- @module.dhall@ → @recipe.dhall@ → @blueprint.dhall@ → @prompt.dhall@ → 'EmptyRepo'.+-- A stray @module.dhall@ next to a @blueprint.dhall@ resolves as the+-- module: the more specific, deterministic artifact wins.+probeSingleArtifact :: FilePath -> IO RepoContents+probeSingleArtifact repoRoot = do+  let moduleFile = repoRoot </> "module.dhall"+      recipeFile = repoRoot </> "recipe.dhall"+      blueprintFile = repoRoot </> "blueprint.dhall"+      promptFile = repoRoot </> "prompt.dhall"+  hasModule <- doesFileExist moduleFile+  if hasModule+    then pure (SingleModule repoRoot)+    else do+      hasRecipe <- doesFileExist recipeFile+      if hasRecipe+        then pure (SingleRecipe repoRoot)+        else do+          hasBlueprint <- doesFileExist blueprintFile+          if hasBlueprint+            then pure (SingleBlueprint repoRoot)+            else do+              hasPrompt <- doesFileExist promptFile+              if hasPrompt+                then pure (SinglePrompt repoRoot)+                else pure EmptyRepo++-- | Validate a registry's entries against the filesystem.+-- Returns a list of error messages (empty means valid).+-- Checks: module name format, path safety, entry file existence,+-- and no name collisions between modules, recipes, blueprints, and prompts.+validateRegistry :: FilePath -> Registry -> IO [Text]+validateRegistry repoRoot reg = do+  modErrs <- concat <$> mapM (validateModuleEntry repoRoot) reg.modules+  recErrs <- concat <$> mapM (validateRecipeEntry repoRoot) reg.recipes+  bpErrs <- concat <$> mapM (validateBlueprintEntry repoRoot) reg.blueprints+  promptErrs <- concat <$> mapM (validatePromptEntry repoRoot) reg.prompts+  let collisionErrs = checkNameCollisions reg.modules reg.recipes reg.blueprints reg.prompts+  pure (modErrs <> recErrs <> bpErrs <> promptErrs <> collisionErrs)++validateModuleEntry :: FilePath -> RegistryEntry -> IO [Text]+validateModuleEntry repoRoot entry = do+  let nameText = entry.name.unModuleName+      nameErrors = checkName nameText+      pathText = T.pack entry.path+      pathErrors = checkPath pathText+  let moduleDhall = repoRoot </> entry.path </> "module.dhall"+  fileExists <- doesFileExist moduleDhall+  let fileErrors =+        if fileExists+          then []+          else ["registry entry '" <> nameText <> "' points to missing module.dhall at " <> pathText]+  pure (nameErrors <> pathErrors <> fileErrors)+  where+    checkName name+      | validModuleName name = []+      | otherwise = ["registry entry name must match [a-z][a-z0-9-]*, got: " <> name]++    checkPath path+      | T.isPrefixOf "/" path = ["registry entry path must be relative: " <> path]+      | ".." `T.isInfixOf` path = ["registry entry path must not contain '..': " <> path]+      | otherwise = []++validateRecipeEntry :: FilePath -> RegistryEntry -> IO [Text]+validateRecipeEntry repoRoot entry = do+  let nameText = entry.name.unModuleName+      nameErrors = checkRecipeName nameText+      pathText = T.pack entry.path+      pathErrors = checkRecipePath pathText+  let recipeDhall = repoRoot </> entry.path </> "recipe.dhall"+  fileExists <- doesFileExist recipeDhall+  let fileErrors =+        if fileExists+          then []+          else ["registry recipe entry '" <> nameText <> "' points to missing recipe.dhall at " <> pathText]+  pure (nameErrors <> pathErrors <> fileErrors)+  where+    checkRecipeName name+      | validModuleName name = []+      | otherwise = ["registry recipe name must match [a-z][a-z0-9-]*, got: " <> name]++    checkRecipePath path+      | T.isPrefixOf "/" path = ["registry recipe path must be relative: " <> path]+      | ".." `T.isInfixOf` path = ["registry recipe path must not contain '..': " <> path]+      | otherwise = []++validateBlueprintEntry :: FilePath -> RegistryEntry -> IO [Text]+validateBlueprintEntry repoRoot entry = do+  let nameText = entry.name.unModuleName+      nameErrors = checkBlueprintName nameText+      pathText = T.pack entry.path+      pathErrors = checkBlueprintPath pathText+  let blueprintDhall = repoRoot </> entry.path </> "blueprint.dhall"+  fileExists <- doesFileExist blueprintDhall+  let fileErrors =+        if fileExists+          then []+          else ["registry blueprint entry '" <> nameText <> "' points to missing blueprint.dhall at " <> pathText]+  pure (nameErrors <> pathErrors <> fileErrors)+  where+    checkBlueprintName name+      | validModuleName name = []+      | otherwise = ["registry blueprint name must match [a-z][a-z0-9-]*, got: " <> name]++    checkBlueprintPath path+      | T.isPrefixOf "/" path = ["registry blueprint path must be relative: " <> path]+      | ".." `T.isInfixOf` path = ["registry blueprint path must not contain '..': " <> path]+      | otherwise = []++validatePromptEntry :: FilePath -> RegistryEntry -> IO [Text]+validatePromptEntry repoRoot entry = do+  let nameText = entry.name.unModuleName+      nameErrors = checkPromptName nameText+      pathText = T.pack entry.path+      pathErrors = checkPromptPath pathText+  let promptDhall = repoRoot </> entry.path </> "prompt.dhall"+  fileExists <- doesFileExist promptDhall+  let fileErrors =+        if fileExists+          then []+          else ["registry prompt entry '" <> nameText <> "' points to missing prompt.dhall at " <> pathText]+  pure (nameErrors <> pathErrors <> fileErrors)+  where+    checkPromptName name+      | validModuleName name = []+      | otherwise = ["registry prompt name must match [a-z][a-z0-9-]*, got: " <> name]++    checkPromptPath path+      | T.isPrefixOf "/" path = ["registry prompt path must be relative: " <> path]+      | ".." `T.isInfixOf` path = ["registry prompt path must not contain '..': " <> path]+      | otherwise = []++-- | Detect name collisions across module, recipe, blueprint, and prompt entries.+-- Each cross-kind pair sharing a name produces one message; a name that+-- appears in all four kinds produces six messages (one per pair).+checkNameCollisions :: [RegistryEntry] -> [RegistryEntry] -> [RegistryEntry] -> [RegistryEntry] -> [Text]+checkNameCollisions mods recs bps prompts =+  let modNames = map (\e -> e.name.unModuleName) mods+      recNames = map (\e -> e.name.unModuleName) recs+      bpNames = map (\e -> e.name.unModuleName) bps+      promptNames = map (\e -> e.name.unModuleName) prompts+      modRec = [n | n <- modNames, n `elem` recNames]+      modBp = [n | n <- modNames, n `elem` bpNames]+      modPrompt = [n | n <- modNames, n `elem` promptNames]+      recBp = [n | n <- recNames, n `elem` bpNames]+      recPrompt = [n | n <- recNames, n `elem` promptNames]+      bpPrompt = [n | n <- bpNames, n `elem` promptNames]+   in map (\n -> "name collision: '" <> n <> "' appears as both a module and a recipe") modRec+        <> map (\n -> "name collision: '" <> n <> "' appears as both a module and a blueprint") modBp+        <> map (\n -> "name collision: '" <> n <> "' appears as both a module and a prompt") modPrompt+        <> map (\n -> "name collision: '" <> n <> "' appears as both a recipe and a blueprint") recBp+        <> map (\n -> "name collision: '" <> n <> "' appears as both a recipe and a prompt") recPrompt+        <> map (\n -> "name collision: '" <> n <> "' appears as both a blueprint and a prompt") bpPrompt++-- | Check that a text matches @[a-z][a-z0-9-]*@.+-- Duplicated from @Seihou.Core.Module.isValidModuleName@ to avoid+-- a circular module dependency through @Seihou.Dhall.Eval@.+validModuleName :: Text -> Bool+validModuleName t = case T.uncons t of+  Nothing -> False+  Just (c, rest) ->+    (c >= 'a' && c <= 'z')+      && T.all (\ch -> (ch >= 'a' && ch <= 'z') || (ch >= '0' && ch <= '9') || ch == '-') rest++-- | What a registry entry points at on disk.+data EntryKind = ModuleEntry | RecipeEntry | BlueprintEntry | PromptEntry+  deriving stock (Eq, Show, Generic)++-- | Classification of a single registry entry relative to the on-disk+-- @module.dhall@/@recipe.dhall@ version.+data SyncStatus+  = -- | Registry @version@ is 'Nothing', on-disk version is @Just _@.+    SyncMissing+  | -- | Registry @version@ and on-disk version both @Just@ but differ;+    --   carries the new on-disk version.+    SyncStale Text+  | -- | Registry and on-disk versions match (both 'Just' equal or both 'Nothing').+    SyncInSync+  | -- | On-disk @module.dhall@/@recipe.dhall@ absent or unreadable.+    SyncOrphan+  deriving stock (Eq, Show, Generic)++-- | One row of a sync diff, preserving registry order.+data SyncDiff = SyncDiff+  { diffKind :: EntryKind,+    diffName :: ModuleName,+    diffOld :: Maybe Text,+    diffNew :: Maybe Text,+    diffStatus :: SyncStatus+  }+  deriving stock (Eq, Show, Generic)++-- | Output of 'computeRegistrySync': the classifications in registry order,+-- and a 'Registry' with each entry's @version@ field updated to the on-disk+-- value (except 'SyncOrphan' entries, which are preserved as-is).+data SyncReport = SyncReport+  { syncDiffs :: [SyncDiff],+    syncUpdated :: Registry+  }+  deriving stock (Eq, Show, Generic)++-- | Pure core of the version-sync flow. The caller resolves each entry's+-- on-disk version ('Just v', or 'Nothing' for orphaned/unreadable entries)+-- and passes them in; this function classifies and rewrites the registry+-- without performing any IO.+--+-- The lookup list is keyed by @(kind, name)@; entries absent from the list+-- are classified as 'SyncOrphan'.+computeRegistrySync ::+  Registry ->+  [(EntryKind, ModuleName, Maybe Text)] ->+  SyncReport+computeRegistrySync reg lookups =+  SyncReport+    { syncDiffs = moduleDiffs <> recipeDiffs <> blueprintDiffs <> promptDiffs,+      syncUpdated =+        reg+          { modules = zipWith applyDiff moduleDiffs reg.modules,+            recipes = zipWith applyDiff recipeDiffs reg.recipes,+            blueprints = zipWith applyDiff blueprintDiffs reg.blueprints,+            prompts = zipWith applyDiff promptDiffs reg.prompts+          }+    }+  where+    moduleDiffs = map (classify ModuleEntry) reg.modules+    recipeDiffs = map (classify RecipeEntry) reg.recipes+    blueprintDiffs = map (classify BlueprintEntry) reg.blueprints+    promptDiffs = map (classify PromptEntry) reg.prompts++    classify :: EntryKind -> RegistryEntry -> SyncDiff+    classify kind entry =+      let onDisk = lookupOnDisk kind entry.name+          status = case (entry.version, onDisk) of+            (_, OnDiskMissing) -> SyncOrphan+            (Nothing, OnDiskValue Nothing) -> SyncInSync+            (Nothing, OnDiskValue (Just _)) -> SyncMissing+            (Just _, OnDiskValue Nothing) -> SyncInSync+            (Just old, OnDiskValue (Just new))+              | old == new -> SyncInSync+              | otherwise -> SyncStale new+          newVersion = case onDisk of+            OnDiskMissing -> entry.version+            OnDiskValue v -> v+       in SyncDiff+            { diffKind = kind,+              diffName = entry.name,+              diffOld = entry.version,+              diffNew = newVersion,+              diffStatus = status+            }++    applyDiff :: SyncDiff -> RegistryEntry -> RegistryEntry+    applyDiff diff entry = case diff.diffStatus of+      SyncOrphan -> entry+      _ -> entry {version = diff.diffNew}++    lookupOnDisk :: EntryKind -> ModuleName -> OnDiskVersion+    lookupOnDisk kind name =+      case [v | (k, n, v) <- lookups, k == kind, n == name] of+        [] -> OnDiskMissing+        (v : _) -> OnDiskValue v++-- | Three-way state used internally by 'computeRegistrySync' to distinguish+-- \"entry absent from the lookup list\" (orphan) from \"entry present, version+-- field is @Nothing@\" (in-sync with an unversioned module.dhall).+data OnDiskVersion = OnDiskMissing | OnDiskValue (Maybe Text)++-- | Format a single 'SyncDiff' as a human-readable drift warning, or+-- 'Nothing' if the entry is already in sync. Used by @seihou browse@ and+-- @seihou install@ to surface stale registry versions without blocking.+formatDriftWarning :: SyncDiff -> Maybe Text+formatDriftWarning diff = case diff.diffStatus of+  SyncInSync -> Nothing+  SyncOrphan -> Nothing+  SyncMissing ->+    Just $+      kindWord diff.diffKind+        <> " '"+        <> diff.diffName.unModuleName+        <> "' registry version is missing; "+        <> entryFile diff.diffKind+        <> " declares "+        <> renderVersion diff.diffNew+        <> " — run `seihou registry sync-versions`"+  SyncStale newVer ->+    Just $+      kindWord diff.diffKind+        <> " '"+        <> diff.diffName.unModuleName+        <> "' registry version "+        <> renderVersion diff.diffOld+        <> " differs from "+        <> entryFile diff.diffKind+        <> " version "+        <> newVer+        <> " — run `seihou registry sync-versions`"+  where+    renderVersion Nothing = "(none)"+    renderVersion (Just v) = v+    kindWord ModuleEntry = "module"+    kindWord RecipeEntry = "recipe"+    kindWord BlueprintEntry = "blueprint"+    kindWord PromptEntry = "prompt"+    entryFile ModuleEntry = "module.dhall"+    entryFile RecipeEntry = "recipe.dhall"+    entryFile BlueprintEntry = "blueprint.dhall"+    entryFile PromptEntry = "prompt.dhall"++-- | One row of the unified validation report. Either reuses an existing+-- structural error message (path/name/file-existence/collisions) or+-- carries a version-mismatch row classified by 'SyncStatus'.+data RegistryValidationIssue+  = StructuralError Text+  | VersionMismatch SyncDiff+  deriving stock (Eq, Show, Generic)++-- | Whole-registry validation outcome, carrying every issue plus the+-- entry counts used by the human-readable summary line.+data RegistryValidationReport = RegistryValidationReport+  { reportIssues :: [RegistryValidationIssue],+    reportModuleCount :: Int,+    reportRecipeCount :: Int,+    reportBlueprintCount :: Int,+    reportPromptCount :: Int+  }+  deriving stock (Eq, Show, Generic)++-- | True iff the report has at least one issue.+reportHasIssues :: RegistryValidationReport -> Bool+reportHasIssues r = not (null r.reportIssues)++-- | Combine the existing structural checks with version classification.+-- The third argument is the same shape 'computeRegistrySync' takes —+-- the caller loads each entry's @module.dhall@/@recipe.dhall@ once and+-- passes a lookup list keyed by @(kind, name)@.+validateRegistryFull ::+  FilePath ->+  Registry ->+  [(EntryKind, ModuleName, Maybe Text)] ->+  IO RegistryValidationReport+validateRegistryFull repoRoot reg lookups = do+  structuralErrs <- validateRegistry repoRoot reg+  let report = computeRegistrySync reg lookups+      versionIssues =+        [ VersionMismatch d+        | d <- report.syncDiffs,+          isVersionDrift d.diffStatus+        ]+  pure+    RegistryValidationReport+      { reportIssues = map StructuralError structuralErrs <> versionIssues,+        reportModuleCount = length reg.modules,+        reportRecipeCount = length reg.recipes,+        reportBlueprintCount = length reg.blueprints,+        reportPromptCount = length reg.prompts+      }+  where+    isVersionDrift SyncMissing = True+    isVersionDrift (SyncStale _) = True+    isVersionDrift _ = False++-- | Render a single 'RegistryValidationIssue' as a one-line human-readable+-- string. 'VersionMismatch' rows reuse the @modules.foo@/@recipes.bar@+-- prefix used by @sync-versions@ but omit the trailing+-- "run @seihou registry sync-versions@" suggestion — the validate handler+-- prints a single aggregated suggestion at the bottom.+formatValidationIssue :: RegistryValidationIssue -> Text+formatValidationIssue (StructuralError msg) = msg+formatValidationIssue (VersionMismatch diff) =+  validationKindPrefix diff.diffKind+    <> diff.diffName.unModuleName+    <> ": registry version "+    <> validationRenderVersion diff.diffOld+    <> " does not match "+    <> entryFile diff.diffKind+    <> " version "+    <> validationRenderVersion diff.diffNew+  where+    entryFile ModuleEntry = "module.dhall"+    entryFile RecipeEntry = "recipe.dhall"+    entryFile BlueprintEntry = "blueprint.dhall"+    entryFile PromptEntry = "prompt.dhall"++validationKindPrefix :: EntryKind -> Text+validationKindPrefix ModuleEntry = "modules."+validationKindPrefix RecipeEntry = "recipes."+validationKindPrefix BlueprintEntry = "blueprints."+validationKindPrefix PromptEntry = "prompts."++validationRenderVersion :: Maybe Text -> Text+validationRenderVersion Nothing = "(none)"+validationRenderVersion (Just v) = v++-- | Serialize a 'Registry' as a Dhall record literal compatible with+-- 'Seihou.Dhall.Eval.registryDecoder'. Rewrites lose hand-written comments+-- and formatting; see @docs/plans/12-sync-registry-versions.md@ for rationale.+renderRegistryDhall :: Registry -> Text+renderRegistryDhall reg =+  T.unlines+    [ "{ repoName = " <> renderString reg.repoName,+      ", repoDescription = " <> renderOptionalText reg.repoDescription,+      ", modules =",+      renderEntryList reg.modules,+      ", recipes =",+      renderEntryList reg.recipes,+      ", blueprints =",+      renderEntryList reg.blueprints,+      ", prompts =",+      renderEntryList reg.prompts,+      "}"+    ]++renderEntryList :: [RegistryEntry] -> Text+renderEntryList [] =+  "  [] : List { name : Text, version : Optional Text, path : Text, description : Optional Text, tags : List Text }"+renderEntryList entries =+  T.intercalate+    "\n"+    (zipWith renderEntry (True : repeat False) entries <> ["  ]"])++renderEntry :: Bool -> RegistryEntry -> Text+renderEntry isFirst entry =+  T.intercalate+    "\n"+    [ "  " <> opener <> " { name = " <> renderString entry.name.unModuleName,+      "    , version = " <> renderOptionalText entry.version,+      "    , path = " <> renderString (T.pack entry.path),+      "    , description = " <> renderOptionalText entry.description,+      "    , tags = " <> renderTextList entry.tags,+      "    }"+    ]+  where+    opener = if isFirst then "[" else ","++renderOptionalText :: Maybe Text -> Text+renderOptionalText Nothing = "None Text"+renderOptionalText (Just v) = "Some " <> renderString v++renderTextList :: [Text] -> Text+renderTextList [] = "[] : List Text"+renderTextList xs = "[ " <> T.intercalate ", " (map renderString xs) <> " ]"++-- | Render a Dhall double-quoted string literal.+-- Escapes backslashes, double quotes, dollar signs (for interpolation),+-- and common control characters per the Dhall spec.+renderString :: Text -> Text+renderString t = "\"" <> T.concatMap escape t <> "\""+  where+    escape '\\' = "\\\\"+    escape '"' = "\\\""+    escape '$' = "\\$"+    escape '\n' = "\\n"+    escape '\r' = "\\r"+    escape '\t' = "\\t"+    escape c = T.singleton c
+ src/Seihou/Core/Scaffold.hs view
@@ -0,0 +1,200 @@+module Seihou.Core.Scaffold+  ( moduleDhall,+    readmeTemplate,+    blueprintDhall,+    examplePromptMarkdown,+    promptDhall,+    exampleAgentPromptMarkdown,+  )+where++import Data.Text qualified as T+import Seihou.Prelude++-- | Generate the module.dhall content for a new module.+-- The output imports the schema via URL and uses record completion (::).+moduleDhall :: Text -> Text -> Text -> Text+moduleDhall name url hash =+  T.unlines+    [ "let S =",+      "      " <> url,+      "        " <> hash,+      "",+      "in  S.Module::{",+      "    , name = \"" <> name <> "\"",+      "    , version = Some \"0.1.0\"",+      "    , description = Some \"A new seihou module\"",+      "    , vars =",+      "      [ S.VarDecl::{",+      "        , name = \"project.name\"",+      "        , type = \"text\"",+      "        , description = Some \"The name of the project\"",+      "        , required = True",+      "        }",+      "      ]",+      "    , prompts =",+      "      [ S.Prompt::{",+      "        , var = \"project.name\"",+      "        , text = \"What is your project name?\"",+      "        }",+      "      ]",+      "    , steps =",+      "      [ S.Step::{",+      "        , strategy = \"template\"",+      "        , src = \"README.md.tpl\"",+      "        , dest = \"README.md\"",+      "        }",+      "      ]",+      "    }"+    ]++-- | Generate the README.md.tpl template content.+readmeTemplate :: Text+readmeTemplate = "# {{project.name}}\n\nA project generated by seihou.\n"++-- | Generate the blueprint.dhall content for a new blueprint.+-- The output imports the schema via URL and uses record completion (::).+-- The prompt body is kept in a sibling @prompt.md@ file so authors can+-- edit Markdown directly without escaping through Dhall's string literal+-- rules; the Dhall record imports it via @./prompt.md as Text@.+blueprintDhall :: Text -> Text -> Text -> Text+blueprintDhall name url hash =+  T.unlines+    [ "let S =",+      "      " <> url,+      "        " <> hash,+      "",+      "in  S.Blueprint::{",+      "    , name = \"" <> name <> "\"",+      "    , version = Some \"0.1.0\"",+      "    , description = Some \"A new seihou blueprint\"",+      "    , prompt = ./prompt.md as Text",+      "    , vars =",+      "      [ S.VarDecl::{",+      "        , name = \"project.name\"",+      "        , type = \"text\"",+      "        , description = Some \"The name of the project\"",+      "        , required = True",+      "        }",+      "      ]",+      "    , prompts =",+      "      [ S.Prompt::{",+      "        , var = \"project.name\"",+      "        , text = \"What is your project name?\"",+      "        }",+      "      ]",+      "    , baseModules = [] : List S.Dependency.Type",+      "    , files = [] : List S.Blueprint.BlueprintFile.Type",+      "    , tags = [] : List Text",+      "    }"+    ]++-- | Example @prompt.md@ body emitted next to a freshly scaffolded+-- @blueprint.dhall@. The body opens with a @{{project.name}}@+-- placeholder so authors can see prompt-time substitution working, then+-- describes the workflow the agent runner (EP-31) will follow at run+-- time. Authors are expected to edit this file freely; the Dhall record+-- imports it verbatim via @./prompt.md as Text@.+examplePromptMarkdown :: Text+examplePromptMarkdown =+  T.unlines+    [ "# {{project.name}}",+      "",+      "You are helping a user scaffold a new project from this blueprint.",+      "",+      "## What you have access to",+      "",+      "- The user's current working directory (where this blueprint is being",+      "  applied). Read, edit, and create files freely.",+      "- The blueprint's `files/` directory, mounted read-only as reference",+      "  material. Copy or adapt snippets, examples, or partial templates",+      "  from there as needed.",+      "- The full `seihou` and `git` toolsets. Use `seihou run`, `seihou",+      "  status`, and `seihou validate-module` to compose modules and check",+      "  state.",+      "",+      "## How to proceed",+      "",+      "1. Confirm with the user what they are trying to build. Ask clarifying",+      "   questions only when the answer would change a load-bearing decision.",+      "2. Lay down the initial scaffolding. Prefer small, testable pieces over",+      "   one large drop.",+      "3. Iterate with the user, making edits as the design takes shape.",+      "4. Use Conventional Commits (`feat:`, `fix:`, `docs:`, …) when",+      "   committing.",+      "5. Ask before destructive changes (deleting files, force-pushing,",+      "   rewriting history).",+      "",+      "Replace this body with the workflow that fits your blueprint. The",+      "more specific the prompt, the more useful the agent's first pass."+    ]++-- | Generate the prompt.dhall content for a first-class agent prompt.+-- The prompt schema may be ahead of the public pinned schema import during+-- local development, so this scaffold emits a self-contained Dhall record+-- with explicit empty-list types.+promptDhall :: Text -> Text -> Text -> Text+promptDhall name _url _hash =+  T.unlines+    [ "let Prompt =",+      "      { var : Text, text : Text, when : Optional Text, choices : Optional (List Text) }",+      "",+      "let CommandVar =",+      "      { name : Text",+      "      , run : Text",+      "      , workDir : Optional Text",+      "      , when : Optional Text",+      "      , trim : Bool",+      "      , maxBytes : Optional Natural",+      "      }",+      "",+      "let PromptFile =",+      "      { src : Text, description : Optional Text }",+      "",+      "let PromptGuidance =",+      "      { title : Text, body : Text, when : Optional Text }",+      "",+      "let Launch =",+      "      { provider : Optional Text, mode : Optional Text, model : Optional Text }",+      "",+      "in  { name = \"" <> name <> "\"",+      "    , version = Some \"0.1.0\"",+      "    , description = Some \"A reusable agent-session prompt\"",+      "    , prompt = ./prompt.md as Text",+      "    , vars =",+      "      [ { name = \"project.name\"",+      "        , type = \"text\"",+      "        , default = None Text",+      "        , description = Some \"The name of the project\"",+      "        , required = False",+      "        , validation = None Text",+      "        }",+      "      ]",+      "    , prompts = [] : List Prompt",+      "    , commandVars = [] : List CommandVar",+      "    , guidance =",+      "      [ { title = \"Repository workflow\"",+      "        , body = \"Inspect the project before editing, keep changes scoped, and run the smallest useful validation command.\"",+      "        , when = None Text",+      "        }",+      "      ]",+      "    , files = [] : List PromptFile",+      "    , allowedTools = None (List Text)",+      "    , tags = [] : List Text",+      "    , launch = None Launch",+      "    }"+    ]++-- | Example @prompt.md@ body emitted next to a freshly scaffolded+-- @prompt.dhall@. It includes one declared variable placeholder so+-- authors can verify prompt rendering through @seihou prompt run --debug@.+exampleAgentPromptMarkdown :: Text+exampleAgentPromptMarkdown =+  T.unlines+    [ "# {{project.name}}",+      "",+      "You are helping the user with a focused repository task.",+      "",+      "Ask before destructive changes such as deleting files, force-pushing,",+      "or rewriting history."+    ]
+ src/Seihou/Core/SchemaUpgrade.hs view
@@ -0,0 +1,426 @@+module Seihou.Core.SchemaUpgrade+  ( UpgradeIssue (..),+    UpgradeResult (..),+    detectIssues,+    upgradeModuleText,+    issueMessage,+  )+where++import Data.Char (isSpace)+import Data.Text qualified as T+import Seihou.Prelude++-- | Describes a single schema issue found in a module.dhall file.+data UpgradeIssue+  = -- | The module record is missing the @version@ field.+    MissingVersion+  | -- | A step record (at the given 0-based index) is missing the @patch@ field.+    MissingStepPatch Int+  | -- | The module record is missing the @commands@ field.+    MissingCommands+  | -- | A dependency is a bare text string rather than a record.+    BareStringDep Text+  | -- | The empty dependency list uses @List Text@ rather than the record type.+    BareStringDepTypeAnnotation+  | -- | The module is missing the @let S = \<url\>@ schema import.+    MissingSchemaImport+  | -- | The module record is missing the @migrations@ field.+    MissingMigrations+  deriving stock (Eq, Show)++-- | Result of attempting to upgrade a module.dhall text.+data UpgradeResult+  = -- | The module already conforms to the current schema.+    AlreadyCurrent+  | -- | The module was upgraded; contains the new text and issues that were fixed.+    Upgraded Text [UpgradeIssue]+  deriving stock (Eq, Show)++-- | Human-readable description of an upgrade issue.+issueMessage :: UpgradeIssue -> Text+issueMessage MissingVersion = "missing field: version"+issueMessage (MissingStepPatch n) = "missing field: patch (in step " <> T.pack (show (n + 1)) <> ")"+issueMessage MissingCommands = "missing field: commands"+issueMessage (BareStringDep name) = "bare string dependency: " <> name+issueMessage BareStringDepTypeAnnotation = "dependency list uses List Text type annotation"+issueMessage MissingSchemaImport = "missing schema import (let S = ...)"+issueMessage MissingMigrations = "missing field: migrations"++-- | Detect all schema issues in a module.dhall text without modifying it.+-- The schema URL is used to check whether the schema import is present.+detectIssues :: Text -> Text -> [UpgradeIssue]+detectIssues schemaUrl content =+  let ls = T.lines content+   in detectMissingVersion ls+        <> detectMissingStepPatch ls+        <> detectMissingCommands ls+        <> detectBareStringDeps ls+        <> detectDepTypeAnnotation ls+        <> detectMissingSchemaImport schemaUrl ls+        <> detectMissingMigrations ls++-- | Upgrade a module.dhall text to the current canonical schema.+-- Returns 'AlreadyCurrent' if no changes are needed.+-- The schema URL and hash are used to inject the schema import if missing.+upgradeModuleText :: Text -> Text -> Text -> UpgradeResult+upgradeModuleText schemaUrl schemaHash content =+  let issues = detectIssues schemaUrl content+   in if null issues+        then AlreadyCurrent+        else+          let upgraded =+                content+                  & applyIf (MissingVersion `elem` issues) insertVersion+                  & applyIf (any isMissingPatch issues) (insertPatchFields issues)+                  & applyIf (MissingCommands `elem` issues) insertCommands+                  & applyIf (any isBareStringDepIssue issues) convertBareStringDeps+                  & applyIf (BareStringDepTypeAnnotation `elem` issues) convertDepTypeAnnotation+                  & applyIf (MissingSchemaImport `elem` issues) (injectSchemaImport schemaUrl schemaHash)+                  & applyIf (MissingMigrations `elem` issues) insertMigrations+           in Upgraded upgraded issues+  where+    applyIf True f x = f x+    applyIf False _ x = x++    isMissingPatch (MissingStepPatch _) = True+    isMissingPatch _ = False++    isBareStringDepIssue (BareStringDep _) = True+    isBareStringDepIssue _ = False++-- ---------------------------------------------------------------------------+-- Detection+-- ---------------------------------------------------------------------------++detectMissingVersion :: [Text] -> [UpgradeIssue]+detectMissingVersion ls+  | any (matchesField "version") ls = []+  | otherwise = [MissingVersion]++detectMissingCommands :: [Text] -> [UpgradeIssue]+detectMissingCommands ls+  | any (matchesField "commands") ls = []+  | otherwise = [MissingCommands]++detectMissingStepPatch :: [Text] -> [UpgradeIssue]+detectMissingStepPatch ls =+  let blocks = extractStepBlocks ls+   in [ MissingStepPatch i+      | (i, block) <- zip [0 ..] blocks,+        not (any (matchesField "patch") block)+      ]++detectBareStringDeps :: [Text] -> [UpgradeIssue]+detectBareStringDeps ls =+  let depsValue = extractDepsValue ls+   in map BareStringDep (extractBareStrings depsValue)++detectDepTypeAnnotation :: [Text] -> [UpgradeIssue]+detectDepTypeAnnotation ls+  | any (\l -> "List Text" `T.isInfixOf` l && matchesField "dependencies" l) ls =+      [BareStringDepTypeAnnotation]+  | otherwise = []++detectMissingSchemaImport :: Text -> [Text] -> [UpgradeIssue]+detectMissingSchemaImport schemaUrl ls+  | any (\l -> "let S =" `T.isInfixOf` l || "let Schema =" `T.isInfixOf` l) ls,+    any (T.isInfixOf "seihou-schema") ls =+      []+  | -- Also accept if the schema URL itself appears (e.g. different binding name)+    any (T.isInfixOf schemaUrl) ls =+      []+  | otherwise = [MissingSchemaImport]++detectMissingMigrations :: [Text] -> [UpgradeIssue]+detectMissingMigrations ls+  | any (matchesField "migrations") ls = []+  | otherwise = [MissingMigrations]++-- ---------------------------------------------------------------------------+-- Rewriting+-- ---------------------------------------------------------------------------++-- | Insert @, version = None Text@ after the @{ name = ...@ line.+insertVersion :: Text -> Text+insertVersion = mapLines $ \line ->+  if matchesFieldStart "name" line+    then [line, ", version = None Text"]+    else [line]++-- | Insert @, patch = None Text@ into step records that are missing it.+insertPatchFields :: [UpgradeIssue] -> Text -> Text+insertPatchFields issues content =+  let missingIndices = [i | MissingStepPatch i <- issues]+      ls = T.lines content+   in T.unlines (go ls 0 missingIndices False)+  where+    go [] _ _ _ = []+    go (l : rest) idx missing inStep+      | not inStep && containsStepStart l =+          l : go rest idx missing True+      | inStep && isBlockEnd l =+          if idx `elem` missing+            then "    , patch = None Text" : l : go rest (idx + 1) missing False+            else l : go rest (idx + 1) missing False+      | otherwise = l : go rest idx missing inStep++    isBlockEnd line =+      let s = T.stripEnd line+          stripped = T.stripStart line+       in "}" `T.isSuffixOf` s+            && not (containsStepStart stripped)++-- | Insert @, commands = ...@ before @, dependencies =@.+insertCommands :: Text -> Text+insertCommands = mapLines $ \line ->+  if matchesField "dependencies" line+    then [", commands = [] : List { run : Text, workDir : Optional Text, when : Optional Text }", line]+    else [line]++-- | Convert bare string dependencies to record form.+convertBareStringDeps :: Text -> Text+convertBareStringDeps content =+  let ls = T.lines content+      (before, rest) = break (matchesField "dependencies") ls+   in case rest of+        [] -> content+        _ ->+          let (depsLines, after) = spanDepsRegion rest+              converted = convertDepsLines depsLines+           in T.unlines (before <> converted <> after)++-- | Inject a schema import line and wrap the existing record in @S.Module::@.+-- Prepends @let S = \<url\> \<hash\>@ and replaces the opening @{@ with @in  S.Module::{@.+injectSchemaImport :: Text -> Text -> Text -> Text+injectSchemaImport url hash content =+  let header =+        T.unlines+          [ "let S =",+            "      " <> url,+            "        " <> hash,+            ""+          ]+      ls = T.lines content+      -- Find the first line that starts with '{' (the module record)+      (before, recordLines) = break (T.isPrefixOf "{" . T.stripStart) ls+   in case recordLines of+        [] -> header <> content+        (firstLine : rest) ->+          let -- Replace the leading '{' with 'in  S.Module::{'+              stripped = T.stripStart firstLine+              replaced = "in  S.Module::" <> stripped+           in header <> T.unlines (before <> (replaced : rest))++-- | Convert @[] : List Text@ to the record type annotation.+convertDepTypeAnnotation :: Text -> Text+convertDepTypeAnnotation =+  T.replace+    "[] : List Text"+    "[] : List { module : Text, vars : List { name : Text, value : Text } }"++-- | Insert @, migrations = [] : List S.Migration.Type@ before the closing+-- brace of the module record. Inserts after the @removal = ...@ line if+-- present (it always is on a current schema), otherwise before the closing+-- brace as a fallback.+insertMigrations :: Text -> Text+insertMigrations content =+  let ls = T.lines content+      -- For modules using the schema package, S.Migration.Type is the right+      -- type. For legacy modules without the schema import we still emit the+      -- same line — it will be a forward reference fixed up by adding the+      -- schema import (MissingSchemaImport handler runs separately).+      migrationsLine = "    , migrations = [] : List S.Migration.Type"+      legacyMigrationsLine = ", migrations = [] : List { from : Text, to : Text, ops : List < MoveFile : { src : Text, dest : Text } | MoveDir : { src : Text, dest : Text } | DeleteFile : { path : Text } | DeleteDir : { path : Text } | RunCommand : { run : Text, workDir : Optional Text } > }"+      hasSchemaImport =+        any (\l -> "let S =" `T.isInfixOf` l || "let Schema =" `T.isInfixOf` l) ls+      lineToInsert = if hasSchemaImport then migrationsLine else legacyMigrationsLine+   in T.unlines (insertBeforeClose lineToInsert ls)+  where+    -- Insert the new line just before the line that closes the module+    -- record. The closing line is the last line that is exactly @}@ or+    -- @  }@ (the schema-completion-syntax close). We look for the last+    -- such line so we insert into the outermost record, not nested ones.+    insertBeforeClose newLine xs =+      case findLastClosing xs of+        Just idx ->+          take idx xs ++ [newLine] ++ drop idx xs+        Nothing -> xs ++ [newLine]++    findLastClosing :: [Text] -> Maybe Int+    findLastClosing xs =+      let indexed = zip [0 ..] xs+          closes = [i | (i, l) <- indexed, isClosingBrace l]+       in case closes of+            [] -> Nothing+            _ -> Just (last closes)++    isClosingBrace :: Text -> Bool+    isClosingBrace l =+      let s = T.strip l+       in s == "}" || s == "} : T"++-- ---------------------------------------------------------------------------+-- Text utilities+-- ---------------------------------------------------------------------------++-- | Check if a line contains a field assignment like @, fieldName =@ or+-- @{ fieldName =@.+matchesField :: Text -> Text -> Bool+matchesField fieldName line =+  let s = T.stripStart line+   in (", " <> fieldName <> " =") `T.isPrefixOf` s+        || (", " <> fieldName <> "=") `T.isPrefixOf` s+        || ("{ " <> fieldName <> " =") `T.isPrefixOf` s++-- | Like 'matchesField' but only for the first field in a record (using @{@).+matchesFieldStart :: Text -> Text -> Bool+matchesFieldStart fieldName line =+  let s = T.stripStart line+   in ("{ " <> fieldName <> " =") `T.isPrefixOf` s++-- | Apply a per-line transformation and reassemble.+mapLines :: (Text -> [Text]) -> Text -> Text+mapLines f = T.unlines . concatMap f . T.lines++-- | Check if a line contains @{ strategy =@ (possibly preceded by @[@ or @,@).+containsStepStart :: Text -> Bool+containsStepStart line = "{ strategy =" `T.isInfixOf` line || "{ strategy=" `T.isInfixOf` line++-- | Extract step blocks from lines. A step block starts with a line containing+-- @{ strategy =@ and ends at the next line ending with @}@.+extractStepBlocks :: [Text] -> [[Text]]+extractStepBlocks [] = []+extractStepBlocks (l : rest)+  | containsStepStart l =+      let (block, remaining) = spanBlock (l : rest)+       in block : extractStepBlocks remaining+  | otherwise = extractStepBlocks rest+  where+    spanBlock [] = ([], [])+    spanBlock (x : xs)+      | "}" `T.isSuffixOf` T.stripEnd x = ([x], xs)+      | otherwise =+          let (block, remaining) = spanBlock xs+           in (x : block, remaining)++-- | Extract the raw value portion of the dependencies field.+-- For @, dependencies = [ "foo", "bar" ]@ this returns @[ "foo", "bar" ]@.+-- For multi-line deps, concatenates all lines.+extractDepsValue :: [Text] -> Text+extractDepsValue ls =+  let region = extractDepsRegion ls+   in case region of+        [] -> ""+        (firstLine : rest) ->+          -- Strip the field name prefix from the first line+          let val = case T.breakOn "=" firstLine of+                (_, after)+                  | T.null after -> firstLine+                  | otherwise -> T.drop 1 after -- drop the '='+           in T.unlines (val : rest)++-- | Extract the lines in the dependencies region.+extractDepsRegion :: [Text] -> [Text]+extractDepsRegion ls =+  let (_, rest) = break (matchesField "dependencies") ls+   in case rest of+        [] -> []+        _ -> fst (spanDepsRegion rest)++-- | Split the deps region from the rest of the lines.+spanDepsRegion :: [Text] -> ([Text], [Text])+spanDepsRegion [] = ([], [])+spanDepsRegion (l : rest)+  -- Single-line: , dependencies = [ "foo" ] or , dependencies = [] : List Text+  | matchesField "dependencies" l+      && ("]" `T.isSuffixOf` T.stripEnd l || "List Text" `T.isSuffixOf` T.stripEnd l) =+      ([l], rest)+  | matchesField "dependencies" l = collectUntilClose [l] rest+  | otherwise = ([], l : rest)+  where+    collectUntilClose acc [] = (reverse acc, [])+    collectUntilClose acc (x : xs)+      | "]" `T.isSuffixOf` T.stripEnd x = (reverse (x : acc), xs)+      | otherwise = collectUntilClose (x : acc) xs++-- | Extract bare string names from a deps value text.+-- Handles both single-line @[ "foo", "bar" ]@ and multi-line formats.+-- A bare string dep is a quoted string that is NOT preceded by @module =@+-- (which would make it a record field value rather than a bare dep).+extractBareStrings :: Text -> [Text]+extractBareStrings t =+  let pieces = T.splitOn "\"" t+   in extractOddElements pieces+  where+    extractOddElements (context : name : rest)+      -- Skip if the name contains '=' which would mean it's part of a record field value+      | "=" `T.isInfixOf` name = extractOddElements rest+      -- Skip if it looks like a type annotation (contains ':')+      | ":" `T.isInfixOf` name = extractOddElements rest+      | T.null name = extractOddElements rest+      -- Skip if preceded by 'module =' — this is a record-form dependency value+      | "module =" `T.isInfixOf` context = extractOddElements rest+      | "module=" `T.isInfixOf` context = extractOddElements rest+      | otherwise = name : extractOddElements rest+    extractOddElements _ = []++-- | Convert dependency lines, handling both single-line and multi-line formats.+convertDepsLines :: [Text] -> [Text]+convertDepsLines [] = []+convertDepsLines [singleLine]+  -- Single-line deps: , dependencies = [ "foo", "bar" ]+  | matchesField "dependencies" singleLine =+      let indent = T.takeWhile isSpace singleLine+          bareNames = extractBareStrings singleLine+       in case bareNames of+            [] -> [singleLine] -- no bare strings to convert, leave as-is+            _ ->+              let entries =+                    [ "  { module = \"" <> name <> "\", vars = [] : List { name : Text, value : Text } }"+                    | name <- bareNames+                    ]+                  formatted = case entries of+                    [] -> [indent <> ", dependencies = [] : List { module : Text, vars : List { name : Text, value : Text } }"]+                    [e] -> [indent <> ", dependencies = [ " <> T.stripStart e <> " ]"]+                    (first : mid) ->+                      let lastEntry = last mid+                          midEntries = init mid+                       in [indent <> ", dependencies ="]+                            <> [indent <> "  [ " <> T.stripStart first]+                            <> [indent <> "  , " <> T.stripStart e | e <- midEntries]+                            <> [indent <> "  , " <> T.stripStart lastEntry]+                            <> [indent <> "  ]"]+               in formatted+convertDepsLines ls =+  -- Multi-line: convert each line that contains a bare string+  map convertMultiLineDepEntry ls+  where+    convertMultiLineDepEntry line+      | hasBareString line =+          let indent = T.takeWhile isSpace line+              s = T.stripStart line+              prefix+                | "[ " `T.isPrefixOf` s = indent <> "[ "+                | "[" `T.isPrefixOf` s = indent <> "[ "+                | ", " `T.isPrefixOf` s = indent <> ", "+                | otherwise = indent <> "  "+              name = extractSingleBareString line+              trailingClose = if "]" `T.isSuffixOf` T.stripEnd line then " ]" else ""+           in prefix <> "{ module = \"" <> name <> "\", vars = [] : List { name : Text, value : Text } }" <> trailingClose+      | otherwise = line++    hasBareString line =+      let s = T.strip line+          cleaned = T.dropWhile (\c -> c == '[' || c == ',' || c == ' ') s+       in case T.uncons (T.stripStart cleaned) of+            Just ('"', _) -> not ("{" `T.isInfixOf` s)+            _ -> False++    extractSingleBareString line =+      let s = T.strip line+          cleaned = T.filter (\c -> c /= '[' && c /= ']' && c /= ',') s+          trimmed = T.strip cleaned+       in case T.stripPrefix "\"" trimmed >>= T.stripSuffix "\"" of+            Just name -> name+            Nothing -> trimmed
+ src/Seihou/Core/Status.hs view
@@ -0,0 +1,41 @@+module Seihou.Core.Status+  ( computeTrackedFileStatuses,+  )+where++import Data.List (sortOn)+import Data.Map.Strict qualified as Map+import Seihou.Core.Types+import Seihou.Effect.Filesystem (Filesystem, doesFileExist, readFileText)+import Seihou.Manifest.Hash (hashContent)+import Seihou.Prelude++-- | Compare each file in the manifest against its current disk content.+-- Returns a sorted list of tracked files with their status:+-- 'TfsUnchanged' if the disk hash matches, 'TfsModified' if it differs,+-- 'TfsDeleted' if the file no longer exists on disk.+computeTrackedFileStatuses :: (Filesystem :> es) => Manifest -> Eff es [TrackedFile]+computeTrackedFileStatuses manifest = do+  results <- mapM classifyFile (Map.toAscList manifest.files)+  pure (sortOn (.path) results)+  where+    classifyFile :: (Filesystem :> es') => (FilePath, FileRecord) -> Eff es' TrackedFile+    classifyFile (path, record) = do+      exists <- doesFileExist path+      status <-+        if not exists+          then pure TfsDeleted+          else do+            content <- readFileText path+            let diskHash = hashContent content+            pure+              ( if diskHash == record.hash+                  then TfsUnchanged+                  else TfsModified+              )+      pure+        TrackedFile+          { path = path,+            moduleName = record.moduleName,+            status = status+          }
+ src/Seihou/Core/Types.hs view
@@ -0,0 +1,629 @@+module Seihou.Core.Types+  ( ModuleName (..),+    VarName (..),+    VarType (..),+    VarValue (..),+    Validation (..),+    VarDecl (..),+    VarExport (..),+    Prompt (..),+    Expr (..),+    Strategy (..),+    PatchOp (..),+    Step (..),+    Command (..),+    Dependency (..),+    simpleDep,+    depModuleNames,+    ParentVars (..),+    emptyParentVars,+    parentVarsFromDep,+    RemovalAction (..),+    RemovalStep (..),+    Removal (..),+    Module (..),+    RecipeName (..),+    Recipe (..),+    BlueprintFile (..),+    Blueprint (..),+    CommandVar (..),+    PromptGuidance (..),+    AgentPromptLaunch (..),+    AgentPrompt (..),+    Runnable (..),+    recipeNameToModuleName,+    Operation (..),+    ModuleLoadError (..),+    Manifest (..),+    AppliedModule (..),+    AppliedRecipe (..),+    AppliedBlueprint (..),+    FileRecord (..),+    SHA256 (..),+    DiffResult (..),+    PlannedFile (..),+    ModifiedFile (..),+    ConflictFile (..),+    OrphanedFile (..),+    ConflictResolution (..),+    VarSource (..),+    ResolvedVar (..),+    VarError (..),+    PlaceholderError (..),+    CompositionWarning (..),+    ConfigError (..),+    ConfigScope (..),+    LogLevel (..),+    TrackedFileStatus (..),+    TrackedFile (..),+  )+where++import Data.Map.Strict (Map)+import Data.String (IsString)+import Data.Text (Text)+import Data.Time (UTCTime)+import GHC.Generics (Generic)+import Numeric.Natural (Natural)+import Seihou.Core.Migration (Migration)++-- | A module identifier such as @"haskell-base"@.+newtype ModuleName = ModuleName {unModuleName :: Text}+  deriving stock (Eq, Ord, Show, Generic)+  deriving newtype (IsString)++-- | A variable identifier such as @"project.name"@.+newtype VarName = VarName {unVarName :: Text}+  deriving stock (Eq, Ord, Show, Generic)+  deriving newtype (IsString)++-- | The type of a variable declaration.+data VarType+  = VTText+  | VTBool+  | VTInt+  | VTList VarType+  | VTChoice [Text]+  deriving stock (Eq, Show, Generic)++-- | A concrete variable value.+data VarValue+  = VText Text+  | VBool Bool+  | VInt Int+  | VList [VarValue]+  deriving stock (Eq, Show, Generic)++-- | Validation constraints on a variable.+data Validation+  = ValPattern Text+  | ValRange Int Int+  | ValMinLength Int+  | ValMaxLength Int+  deriving stock (Eq, Show, Generic)++-- | A variable declaration within a module.+data VarDecl = VarDecl+  { name :: VarName,+    type_ :: VarType,+    default_ :: Maybe VarValue,+    description :: Maybe Text,+    required :: Bool,+    validation :: Maybe Validation+  }+  deriving stock (Eq, Show, Generic)++-- | A variable export for cross-module visibility.+data VarExport = VarExport+  { var :: VarName,+    alias :: Maybe VarName+  }+  deriving stock (Eq, Show, Generic)++-- | An interactive prompt for a variable.+data Prompt = Prompt+  { var :: VarName,+    text :: Text,+    condition :: Maybe Expr,+    choices :: Maybe [Text]+  }+  deriving stock (Eq, Show, Generic)++-- | Expression AST for conditional logic in @when@ clauses.+-- Expressions are stored as strings in Dhall (e.g., @"IsSet license && Eq license MIT"@)+-- and parsed into this AST by the expression parser in @Seihou.Core.Expr@.+data Expr+  = ExprEq VarName VarValue+  | ExprAnd Expr Expr+  | ExprOr Expr Expr+  | ExprNot Expr+  | ExprIsSet VarName+  | ExprLit Bool+  deriving stock (Eq, Show, Generic)++-- | The four generation strategies.+data Strategy+  = Copy+  | Template+  | DhallText+  | Structured+  deriving stock (Eq, Show, Generic)++-- | Patch operations for modifying existing files during composition.+-- A step with a 'PatchOp' contributes content to a file that another module+-- creates, rather than overwriting it.+data PatchOp+  = AppendFile+  | PrependFile+  | AppendSection+  | AppendLineIfAbsent+  deriving stock (Eq, Show, Generic)++-- | A generation step within a module.+data Step = Step+  { strategy :: Strategy,+    src :: FilePath,+    dest :: Text,+    condition :: Maybe Expr,+    patch :: Maybe PatchOp+  }+  deriving stock (Eq, Show, Generic)++-- | A shell command to run after file generation.+data Command = Command+  { run :: Text,+    workDir :: Maybe Text,+    condition :: Maybe Expr+  }+  deriving stock (Eq, Show, Generic)++-- | A dependency on another module, optionally supplying variable bindings.+-- When @depVars@ is non-empty, the listed variables are pre-supplied to the+-- dependency during resolution, sitting between global config and module+-- defaults in the precedence chain.+data Dependency = Dependency+  { depModule :: ModuleName,+    depVars :: Map VarName Text+  }+  deriving stock (Eq, Show, Generic)++-- | Create a bare dependency with no variable bindings.+simpleDep :: ModuleName -> Dependency+simpleDep name = Dependency {depModule = name, depVars = mempty}++-- | Extract module names from a list of dependencies.+depModuleNames :: [Dependency] -> [ModuleName]+depModuleNames = map (.depModule)++-- | The variable bindings supplied by a dependent module along a specific+-- dependency edge. This is the "edge decoration" — the identity of a+-- 'ModuleInstance' is determined by the @depVars@ the parent supplied,+-- not by anything resolved downstream.+--+-- The underlying 'Data.Map.Strict' @Ord@ instance gives structural equality:+-- two 'ParentVars' values are equal iff they contain the same name/value+-- pairs regardless of construction order.+newtype ParentVars = ParentVars {unParentVars :: Map VarName Text}+  deriving stock (Eq, Ord, Show, Generic)++-- | The identity used when a module is invoked with no parent-supplied+-- bindings (the CLI primary module, recipe-expanded additionals, or any+-- dependency declared with @vars = []@).+emptyParentVars :: ParentVars+emptyParentVars = ParentVars mempty++-- | Build 'ParentVars' from a 'Dependency' record's @depVars@ field.+parentVarsFromDep :: Dependency -> ParentVars+parentVarsFromDep dep = ParentVars dep.depVars++-- | The type of removal action for a removal step.+data RemovalAction+  = -- | Delete the file entirely.+    RemoveFileAction+  | -- | Strip this module's section markers from the file.+    RemoveSectionAction+  | -- | Apply a Dhall text function to transform the file.+    RewriteFileAction+  deriving stock (Eq, Show, Generic)++-- | A single removal step describing how to reverse one effect of a module.+data RemovalStep = RemovalStep+  { action :: RemovalAction,+    dest :: Text,+    src :: Maybe FilePath+  }+  deriving stock (Eq, Show, Generic)++-- | Removal specification for a module.+data Removal = Removal+  { removalSteps :: [RemovalStep],+    removalCommands :: [Command]+  }+  deriving stock (Eq, Show, Generic)++-- | A module definition: the fundamental unit of composition.+data Module = Module+  { name :: ModuleName,+    version :: Maybe Text,+    description :: Maybe Text,+    vars :: [VarDecl],+    exports :: [VarExport],+    prompts :: [Prompt],+    steps :: [Step],+    commands :: [Command],+    dependencies :: [Dependency],+    removal :: Maybe Removal,+    migrations :: [Migration]+  }+  deriving stock (Eq, Show, Generic)++-- | A recipe identifier such as @"haskell-library"@.+-- Shares the same @[a-z][a-z0-9-]*@ namespace as 'ModuleName'.+newtype RecipeName = RecipeName {unRecipeName :: Text}+  deriving stock (Eq, Ord, Show, Generic)+  deriving newtype (IsString)++-- | A recipe: a named, reusable composition of modules with optional+-- pre-configured variable bindings.+data Recipe = Recipe+  { name :: RecipeName,+    version :: Maybe Text,+    description :: Maybe Text,+    modules :: [Dependency],+    vars :: [VarDecl],+    prompts :: [Prompt]+  }+  deriving stock (Eq, Show, Generic)++-- | A reference to a file in a blueprint's @files/@ subdirectory.+-- The runner mounts the blueprint's @files/@ directory into the+-- agent's filesystem; @description@ is shown to the agent so it can+-- pick the right reference for the user's request.+data BlueprintFile = BlueprintFile+  { src :: FilePath,+    description :: Maybe Text+  }+  deriving stock (Eq, Show, Generic)++-- | A blueprint: an agent-driven runnable artifact bundling a base+-- prompt, optional baseline modules, and reference files. Blueprints+-- are not directly executable — running @seihou run@ on a blueprint+-- name refuses with an actionable message; the agent runner+-- @seihou agent run@ (EP-31) consumes them instead.+data Blueprint = Blueprint+  { name :: ModuleName,+    version :: Maybe Text,+    description :: Maybe Text,+    prompt :: Text,+    vars :: [VarDecl],+    prompts :: [Prompt],+    baseModules :: [Dependency],+    files :: [BlueprintFile],+    allowedTools :: Maybe [Text],+    tags :: [Text]+  }+  deriving stock (Eq, Show, Generic)++-- | A prompt variable whose value is produced by running a local command.+-- Process execution is implemented outside the core Dhall decoder; this+-- record only captures the author-declared command and safety metadata.+data CommandVar = CommandVar+  { name :: VarName,+    run :: Text,+    workDir :: Maybe Text,+    condition :: Maybe Expr,+    trim :: Bool,+    maxBytes :: Maybe Natural+  }+  deriving stock (Eq, Show, Generic)++-- | A Markdown instruction block attached to an agent prompt. The optional+-- condition is evaluated after normal and command-derived variables resolve.+data PromptGuidance = PromptGuidance+  { title :: Text,+    body :: Text,+    condition :: Maybe Expr+  }+  deriving stock (Eq, Show, Generic)++-- | Optional launch metadata declared by an agent prompt. The CLI runner may+-- use this as a default provider/model/mode hint, but project or CLI config+-- remains authoritative.+data AgentPromptLaunch = AgentPromptLaunch+  { provider :: Maybe Text,+    mode :: Maybe Text,+    model :: Maybe Text+  }+  deriving stock (Eq, Show, Generic)++-- | A reusable agent-session prompt. Unlike 'Blueprint', an 'AgentPrompt'+-- does not declare baseline modules and does not imply scaffolding or+-- manifest provenance.+data AgentPrompt = AgentPrompt+  { name :: ModuleName,+    version :: Maybe Text,+    description :: Maybe Text,+    prompt :: Text,+    vars :: [VarDecl],+    prompts :: [Prompt],+    commandVars :: [CommandVar],+    guidance :: [PromptGuidance],+    files :: [BlueprintFile],+    allowedTools :: Maybe [Text],+    tags :: [Text],+    launch :: Maybe AgentPromptLaunch+  }+  deriving stock (Eq, Show, Generic)++-- | The result of name-based discovery: a module, recipe, blueprint, or prompt.+data Runnable+  = RunnableModule Module FilePath+  | RunnableRecipe Recipe FilePath+  | RunnableBlueprint Blueprint FilePath+  | RunnableAgentPrompt AgentPrompt FilePath+  deriving stock (Show)++-- | Convert a 'RecipeName' to a 'ModuleName' (they share a namespace).+recipeNameToModuleName :: RecipeName -> ModuleName+recipeNameToModuleName (RecipeName t) = ModuleName t++-- | Filesystem operations produced by the generation engine.+data Operation+  = WriteFileOp+      { dest :: FilePath,+        content :: Text,+        strategy :: Strategy+      }+  | CreateDirOp+      { path :: FilePath+      }+  | CopyFileOp+      { src :: FilePath,+        dest :: FilePath+      }+  | RunCommandOp+      { command :: Text,+        workDir :: Maybe FilePath+      }+  | PatchFileOp+      { dest :: FilePath,+        content :: Text,+        op :: PatchOp,+        strategy :: Strategy,+        moduleName :: ModuleName+      }+  deriving stock (Eq, Show, Generic)++-- | Errors that can occur during module loading and validation.+data ModuleLoadError+  = ModuleNotFound ModuleName [FilePath]+  | DhallEvalError ModuleName Text+  | DhallDecodeError ModuleName Text+  | ValidationError ModuleName [Text]+  | CircularDependency [ModuleName]+  | MissingSourceFile ModuleName FilePath+  | RegistryEvalError Text Text+  deriving stock (Eq, Show, Generic)++-- | Tracks where a variable's value came from (for provenance / @--explain@).+data VarSource+  = FromCLI+  | FromEnv Text+  | FromLocalConfig+  | FromNamespaceConfig Text+  | FromContextConfig Text+  | FromGlobalConfig+  | FromParent ModuleName+  | FromDefault+  | FromPrompt+  | FromCommand Text+  deriving stock (Eq, Show, Generic)++-- | A variable that has been resolved to a concrete value with provenance.+data ResolvedVar = ResolvedVar+  { value :: VarValue,+    source :: VarSource,+    decl :: VarDecl+  }+  deriving stock (Eq, Show, Generic)++-- | Errors that can occur during variable resolution.+data VarError+  = MissingRequiredVar VarName+  | TypeMismatch VarName VarType VarValue+  | ValidationFailed VarName Text+  | CoercionFailed VarName VarType Text+  deriving stock (Eq, Show, Generic)++-- | Errors that can occur during template placeholder substitution+-- and conditional-block expansion.+data PlaceholderError+  = UnresolvedPlaceholder VarName Int+  | MalformedPlaceholder Text Int+  | -- | @{{#if …}}@ with no matching @{{/if}}@; line is the opener.+    UnterminatedIf Int+  | -- | @{{/if}}@ or @{{#else}}@ encountered outside any @{{#if}}@.+    OrphanBlockToken Text Int+  | -- | The expression inside a @{{#if …}}@ failed to parse;+    --   fields are the raw expression, the opener's line, and the parser error.+    MalformedIfExpression Text Int Text+  deriving stock (Eq, Show, Generic)++-- | Tracks the state of generated files for incremental re-generation+-- and conflict detection. Stored at @.seihou/manifest.json@.+data Manifest = Manifest+  { version :: Int,+    genAt :: UTCTime,+    modules :: [AppliedModule],+    vars :: Map VarName Text,+    files :: Map FilePath FileRecord,+    recipe :: Maybe AppliedRecipe,+    blueprint :: Maybe AppliedBlueprint+  }+  deriving stock (Eq, Show, Generic)++-- | Recipe provenance recorded in the manifest when a recipe is used.+data AppliedRecipe = AppliedRecipe+  { name :: RecipeName,+    recipeVersion :: Maybe Text,+    appliedAt :: UTCTime+  }+  deriving stock (Eq, Show, Generic)++-- | Blueprint provenance recorded in the manifest after a successful+-- @seihou agent run@ invocation. The agent owns file output, so this+-- entry describes the *invocation* (which blueprint, which baseline, the+-- user's prompt) — not the file set the agent produced.+--+-- @baselineModules@ records the modules the runner applied as the+-- baseline. @noBaseline@ distinguishes "no baseline declared"+-- (@baselineModules = []@, @noBaseline = False@) from "baseline skipped+-- by user" (@baselineModules = []@, @noBaseline = True@).+-- @userPrompt@ captures the positional @PROMPT@ argument when supplied.+-- @agentSessionId@ is reserved for the deferred resume feature recorded+-- in @docs/masterplans/3-agent-driven-blueprints.md@; in v1 it is always+-- 'Nothing' and the encoder omits the JSON key in that case.+data AppliedBlueprint = AppliedBlueprint+  { name :: ModuleName,+    blueprintVersion :: Maybe Text,+    appliedAt :: UTCTime,+    baselineModules :: [ModuleName],+    noBaseline :: Bool,+    userPrompt :: Maybe Text,+    agentSessionId :: Maybe Text+  }+  deriving stock (Eq, Show, Generic)++-- | A module that has been applied to generate files.+--+-- The @parentVars@ field disambiguates multiple invocations of the same+-- module within a single composition: two 'AppliedModule' entries with+-- the same @name@ and different @parentVars@ represent two legitimate+-- instances. Manifests produced before schema version 2 decode with+-- @parentVars = 'emptyParentVars'@.+data AppliedModule = AppliedModule+  { name :: ModuleName,+    parentVars :: ParentVars,+    source :: FilePath,+    moduleVersion :: Maybe Text,+    appliedAt :: UTCTime,+    removal :: Maybe Removal+  }+  deriving stock (Eq, Show, Generic)++-- | A record of a generated file, stored in the manifest.+data FileRecord = FileRecord+  { hash :: SHA256,+    moduleName :: ModuleName,+    strategy :: Strategy,+    generatedAt :: UTCTime+  }+  deriving stock (Eq, Show, Generic)++-- | A SHA256 content hash, stored as a hex-encoded text string.+newtype SHA256 = SHA256 {unSHA256 :: Text}+  deriving stock (Eq, Ord, Show, Generic)+  deriving newtype (IsString)++-- | Result of the three-state diff: manifest vs plan vs disk.+data DiffResult = DiffResult+  { new :: [PlannedFile],+    modified :: [ModifiedFile],+    unchanged :: [FilePath],+    conflicts :: [ConflictFile],+    orphaned :: [OrphanedFile]+  }+  deriving stock (Eq, Show, Generic)++-- | A file that exists in the plan but not in the manifest or on disk.+data PlannedFile = PlannedFile+  { path :: FilePath,+    moduleName :: ModuleName,+    content :: Text+  }+  deriving stock (Eq, Show, Generic)++-- | A file that has changed between the manifest and the plan,+-- but the user has not modified the disk copy.+data ModifiedFile = ModifiedFile+  { path :: FilePath,+    moduleName :: ModuleName,+    oldHash :: SHA256,+    newContent :: Text+  }+  deriving stock (Eq, Show, Generic)++-- | A file where the user has modified the disk copy since it was generated.+data ConflictFile = ConflictFile+  { path :: FilePath,+    moduleName :: ModuleName,+    manifestHash :: SHA256,+    diskHash :: SHA256,+    planContent :: Text+  }+  deriving stock (Eq, Show, Generic)++-- | A file that exists in the manifest but not in the current plan+-- (the module that generated it was removed or no longer produces it).+data OrphanedFile = OrphanedFile+  { path :: FilePath,+    moduleName :: ModuleName+  }+  deriving stock (Eq, Show, Generic)++-- | How to resolve a conflict when a user has modified a generated file.+data ConflictResolution+  = AcceptNew+  | KeepCurrent+  | Skip+  | Abort+  deriving stock (Eq, Show, Generic)++-- | Errors that can occur when reading config files.+data ConfigError+  = ConfigParseError FilePath Text+  | InvalidNamespace Text Text+  deriving stock (Eq, Show, Generic)++-- | Controls the verbosity of diagnostic output.+-- 'LogQuiet' shows only errors, 'LogNormal' shows warnings and errors,+-- 'LogVerbose' shows all messages including info and debug.+-- The derived 'Ord' instance gives @LogQuiet < LogNormal < LogVerbose@,+-- which the Logger interpreters use for filtering.+data LogLevel = LogQuiet | LogNormal | LogVerbose+  deriving stock (Eq, Ord, Show, Generic)++-- | Which config scope to read from or write to.+data ConfigScope+  = ScopeLocal+  | ScopeNamespace Text+  | ScopeContext Text+  | ScopeGlobal+  deriving stock (Eq, Show, Generic)++-- | Warnings emitted during multi-module composition.+-- 'FileOverwritten' records that a file produced by one module was+-- overwritten by a later module in execution order (last-writer-wins).+data CompositionWarning+  = FileOverwritten FilePath ModuleName ModuleName+  | ContentMerged FilePath ModuleName ModuleName+  deriving stock (Eq, Show, Generic)++-- | Status of a tracked file relative to its manifest hash.+-- Used by 'seihou status' to classify files by comparing manifest vs disk.+data TrackedFileStatus+  = -- | Disk hash matches manifest hash+    TfsUnchanged+  | -- | Disk hash differs from manifest hash+    TfsModified+  | -- | File not present on disk+    TfsDeleted+  deriving stock (Eq, Show, Generic)++-- | A tracked file with its path, originating module, and disk status.+data TrackedFile = TrackedFile+  { path :: FilePath,+    moduleName :: ModuleName,+    status :: TrackedFileStatus+  }+  deriving stock (Eq, Show, Generic)
+ src/Seihou/Core/Variable.hs view
@@ -0,0 +1,342 @@+module Seihou.Core.Variable+  ( resolveVariables,+    coerceValue,+    coerceDefault,+    validateVarValue,+    formatExplain,+    formatDeclarations,+    envVarName,+    diagnoseResolution,+  )+where++import Data.Char (toUpper)+import Data.Map.Strict qualified as Map+import Data.Maybe (catMaybes)+import Data.Set qualified as Set+import Data.Text qualified as T+import Seihou.Core.Types+import Seihou.Prelude++-- | Derive the environment variable name for a given variable.+-- @VarName "project.name"@ becomes @"SEIHOU_VAR_PROJECT_NAME"@.+envVarName :: VarName -> Text+envVarName (VarName name) =+  "SEIHOU_VAR_" <> T.map (\c -> if c == '.' then '_' else toUpper c) name++-- | Attempt to coerce a text value to the declared variable type.+coerceValue :: VarName -> VarType -> Text -> Either VarError VarValue+coerceValue name VTText t = Right (VText t)+coerceValue name VTBool t =+  case T.toLower (T.strip t) of+    "true" -> Right (VBool True)+    "yes" -> Right (VBool True)+    "1" -> Right (VBool True)+    "false" -> Right (VBool False)+    "no" -> Right (VBool False)+    "0" -> Right (VBool False)+    _ -> Left (CoercionFailed name VTBool t)+coerceValue name VTInt t =+  case reads (T.unpack (T.strip t)) of+    [(n, "")] -> Right (VInt n)+    _ -> Left (CoercionFailed name VTInt t)+coerceValue name (VTList VTText) t =+  Right (VList (map (VText . T.strip) (T.splitOn "," t)))+coerceValue name (VTList elemTy) t =+  Left (CoercionFailed name (VTList elemTy) t)+coerceValue name (VTChoice options) t+  | T.strip t `elem` options = Right (VText (T.strip t))+  | otherwise = Left (CoercionFailed name (VTChoice options) t)++-- | Coerce a module *default* value to its declared type.+--+-- Defaults are decoded from Dhall as raw 'VText'; this routes them through the+-- same 'coerceValue' contract as every other resolution source so a defaulted+-- variable reaches evaluation with the correct runtime type (e.g. a @bool@+-- default of @"true"@ becomes 'VBool' 'True', not 'VText' @"true"@).+--+-- A value that is already typed (e.g. a default synthesized during+-- composition) passes through unchanged. An unconstrained choice+-- (@VTChoice []@ — the only form the Dhall decoder currently produces, since+-- options are not yet carried in the type string) keeps its text value, as+-- there are no options to validate membership against.+coerceDefault :: VarName -> VarType -> VarValue -> Either VarError VarValue+coerceDefault _ (VTChoice []) (VText raw) = Right (VText raw)+coerceDefault name ty (VText raw) = coerceValue name ty raw+coerceDefault _ _ v = Right v++-- | Validate a resolved value against its declaration's validation constraint.+validateVarValue :: VarDecl -> VarValue -> Either VarError ()+validateVarValue decl val =+  case decl.validation of+    Nothing -> Right ()+    Just v -> checkValidation decl.name v val++checkValidation :: VarName -> Validation -> VarValue -> Either VarError ()+checkValidation name (ValPattern pat) (VText t) =+  if simplePatternMatch pat t+    then Right ()+    else Left (ValidationFailed name ("value does not match pattern: " <> pat))+checkValidation name (ValPattern _) _ =+  Left (ValidationFailed name "pattern validation requires a text value")+checkValidation name (ValRange lo hi) (VInt n)+  | n >= lo && n <= hi = Right ()+  | otherwise =+      Left+        ( ValidationFailed+            name+            ( "value "+                <> T.pack (show n)+                <> " is not in range ["+                <> T.pack (show lo)+                <> ", "+                <> T.pack (show hi)+                <> "]"+            )+        )+checkValidation name (ValRange _ _) _ =+  Left (ValidationFailed name "range validation requires an integer value")+checkValidation name (ValMinLength n) (VText t)+  | T.length t >= n = Right ()+  | otherwise =+      Left+        ( ValidationFailed+            name+            ("value must be at least " <> T.pack (show n) <> " characters")+        )+checkValidation name (ValMinLength _) _ =+  Left (ValidationFailed name "min-length validation requires a text value")+checkValidation name (ValMaxLength n) (VText t)+  | T.length t <= n = Right ()+  | otherwise =+      Left+        ( ValidationFailed+            name+            ("value must be at most " <> T.pack (show n) <> " characters")+        )+checkValidation name (ValMaxLength _) _ =+  Left (ValidationFailed name "max-length validation requires a text value")++-- | Simple pattern matching for variable validation.+-- For M2, this checks whether the text matches the character class pattern+-- @[a-z][a-z0-9-]*@ style patterns. A full regex library can be added later.+simplePatternMatch :: Text -> Text -> Bool+simplePatternMatch pat t+  | pat == "[a-z][a-z0-9-]*" =+      case T.uncons t of+        Just (c, rest) ->+          isLowerAlpha c && T.all (\x -> isLowerAlpha x || isDigit x || x == '-') rest+        Nothing -> False+  | otherwise = True -- unknown patterns pass by default+  where+    isLowerAlpha c = c >= 'a' && c <= 'z'+    isDigit c = c >= '0' && c <= '9'++-- | Resolve all variables for a module given CLI overrides, environment variables,+-- four config file layers, and parent-supplied variable bindings.+--+-- Precedence chain (highest to lowest):+-- 1. CLI overrides (@--var@ flags)+-- 2. Environment variables (@SEIHOU_VAR_@ prefix)+-- 3. Local project config (@.seihou\/config.dhall@)+-- 4. Namespace config (@~\/.config\/seihou\/namespaces\/\<ns\>\/config.dhall@)+-- 5. Context config (@~\/.config\/seihou\/contexts\/\<ctx\>\/config.dhall@)+-- 6. Global config (@~\/.config\/seihou\/config.dhall@)+-- 7. Parent-supplied vars (from parameterized dependencies)+-- 8. Module defaults+resolveVariables ::+  [VarDecl] ->+  Map VarName Text -> -- CLI overrides+  Map Text Text -> -- Environment variables+  Text -> -- Namespace name (used in provenance tagging)+  Text -> -- Context name (used in provenance tagging)+  Map VarName Text -> -- Local config+  Map VarName Text -> -- Namespace config+  Map VarName Text -> -- Context config+  Map VarName Text -> -- Global config+  Map VarName (Text, ModuleName) -> -- Parent-supplied vars+  Either [VarError] (Map VarName ResolvedVar)+resolveVariables decls cliOverrides envVars namespace context localConfig nsConfig ctxConfig globalConfig parentVars =+  case partitionResults (map resolveOne decls) of+    ([], resolved) -> Right (Map.fromList (catMaybes resolved))+    (errs, _) -> Left errs+  where+    resolveOne :: VarDecl -> Either VarError (Maybe (VarName, ResolvedVar))+    resolveOne decl =+      let name = decl.name+          ty = decl.type_+       in case lookupCLI name ty of+            Just result -> fmap Just (result >>= validateAndWrap decl)+            Nothing -> case lookupEnv name ty of+              Just result -> fmap Just (result >>= validateAndWrap decl)+              Nothing -> case lookupConfig name ty localConfig FromLocalConfig of+                Just result -> fmap Just (result >>= validateAndWrap decl)+                Nothing -> case lookupConfig name ty nsConfig (FromNamespaceConfig namespace) of+                  Just result -> fmap Just (result >>= validateAndWrap decl)+                  Nothing -> case lookupConfig name ty ctxConfig (FromContextConfig context) of+                    Just result -> fmap Just (result >>= validateAndWrap decl)+                    Nothing -> case lookupConfig name ty globalConfig FromGlobalConfig of+                      Just result -> fmap Just (result >>= validateAndWrap decl)+                      Nothing -> case lookupParent name ty of+                        Just result -> fmap Just (result >>= validateAndWrap decl)+                        Nothing -> case decl.default_ of+                          Just defVal ->+                            case coerceDefault name ty defVal of+                              Left err -> Left err+                              Right val -> fmap Just (validateAndWrap decl (val, FromDefault))+                          Nothing+                            | decl.required -> Left (MissingRequiredVar name)+                            | otherwise -> Right Nothing++    lookupParent :: VarName -> VarType -> Maybe (Either VarError (VarValue, VarSource))+    lookupParent name ty =+      case Map.lookup name parentVars of+        Nothing -> Nothing+        Just (rawText, parentName) ->+          Just $ case coerceValue name ty rawText of+            Left err -> Left err+            Right val -> Right (val, FromParent parentName)++    lookupCLI :: VarName -> VarType -> Maybe (Either VarError (VarValue, VarSource))+    lookupCLI name ty =+      case Map.lookup name cliOverrides of+        Nothing -> Nothing+        Just rawText ->+          Just $ case coerceValue name ty rawText of+            Left err -> Left err+            Right val -> Right (val, FromCLI)++    lookupEnv :: VarName -> VarType -> Maybe (Either VarError (VarValue, VarSource))+    lookupEnv name ty =+      let envKey = envVarName name+       in case Map.lookup envKey envVars of+            Nothing -> Nothing+            Just rawText ->+              Just $ case coerceValue name ty rawText of+                Left err -> Left err+                Right val -> Right (val, FromEnv envKey)++    lookupConfig :: VarName -> VarType -> Map VarName Text -> VarSource -> Maybe (Either VarError (VarValue, VarSource))+    lookupConfig name ty configMap source =+      case Map.lookup name configMap of+        Nothing -> Nothing+        Just rawText ->+          Just $ case coerceValue name ty rawText of+            Left err -> Left err+            Right val -> Right (val, source)++    validateAndWrap :: VarDecl -> (VarValue, VarSource) -> Either VarError (VarName, ResolvedVar)+    validateAndWrap decl (val, source) =+      case validateVarValue decl val of+        Left err -> Left err+        Right () ->+          Right+            ( decl.name,+              ResolvedVar+                { value = val,+                  source = source,+                  decl = decl+                }+            )++-- | Partition a list of Either into errors and successes.+partitionResults :: [Either e a] -> ([e], [a])+partitionResults = foldr go ([], [])+  where+    go (Left e) (errs, oks) = (e : errs, oks)+    go (Right a) (errs, oks) = (errs, a : oks)++-- | Format a human-readable provenance report for @--explain@ output.+-- Uses bracket notation for sources and column-aligned output with 2-space indent.+formatExplain :: Map VarName ResolvedVar -> Text+formatExplain resolved =+  T.unlines (map formatOne entries)+  where+    entries = Map.toAscList resolved++    -- Calculate column widths for alignment+    maxNameLen = maximum (0 : map (\(VarName n, _) -> T.length n) entries)+    maxValueLen = maximum (0 : map (\(_, rv) -> T.length (showValue rv.value)) entries)++    formatOne :: (VarName, ResolvedVar) -> Text+    formatOne (VarName n, rv) =+      let valText = showValue rv.value+          namePad = T.replicate (maxNameLen - T.length n) " "+          valPad = T.replicate (maxValueLen - T.length valText) " "+       in "  " <> n <> namePad <> " = " <> valText <> valPad <> "  " <> showSource rv.source++    showValue :: VarValue -> Text+    showValue (VText t) = "\"" <> t <> "\""+    showValue (VBool True) = "true"+    showValue (VBool False) = "false"+    showValue (VInt n) = T.pack (show n)+    showValue (VList vs) = "[" <> T.intercalate ", " (map showValue vs) <> "]"++    showSource :: VarSource -> Text+    showSource FromCLI = "[--var]"+    showSource (FromEnv envKey) = "[env " <> envKey <> "]"+    showSource FromLocalConfig = "[local config]"+    showSource (FromNamespaceConfig ns) = "[namespace: " <> ns <> "]"+    showSource (FromContextConfig ctx) = "[context: " <> ctx <> "]"+    showSource FromGlobalConfig = "[global config]"+    showSource (FromParent mn) = "[parent: " <> mn.unModuleName <> "]"+    showSource FromDefault = "[default]"+    showSource FromPrompt = "[prompt]"+    showSource (FromCommand cmd) = "[command: " <> cmd <> "]"++-- | Format variable declarations for default mode output.+-- Produces aligned output with @=@ signs and 2-space indent.+formatDeclarations :: [VarDecl] -> Text+formatDeclarations decls =+  T.unlines (map formatOne decls)+  where+    maxNameLen = maximum (0 : map (\d -> T.length d.name.unVarName) decls)++    formatOne :: VarDecl -> Text+    formatOne d =+      let VarName n = d.name+          namePad = T.replicate (maxNameLen - T.length n) " "+          valText = case d.default_ of+            Nothing+              | d.required -> "(required, no default)"+              | otherwise -> "(optional, no default)"+            Just v -> showDeclValue v+       in "  " <> n <> namePad <> " = " <> valText++    showDeclValue :: VarValue -> Text+    showDeclValue (VText t) = "\"" <> t <> "\""+    showDeclValue (VBool True) = "true"+    showDeclValue (VBool False) = "false"+    showDeclValue (VInt n) = T.pack (show n)+    showDeclValue (VList vs) = "[" <> T.intercalate ", " (map showDeclValue vs) <> "]"++-- | Diagnose mismatches between config values and variable declarations.+--+-- Returns two lists:+-- 1. Unused config keys: keys present in any config layer that don't match+--    any declared variable name across the composition.+-- 2. Unresolved optional variables: declared non-required variables that+--    have no resolved value.+diagnoseResolution ::+  Map VarName ResolvedVar ->+  [VarDecl] ->+  Map VarName Text ->+  Map VarName Text ->+  Map VarName Text ->+  Map VarName Text ->+  ([VarName], [VarName])+diagnoseResolution resolved decls localConfig nsConfig ctxConfig globalConfig =+  (unusedConfigKeys, unresolvedOptional)+  where+    declaredNames = Set.fromList (map (.name) decls)+    allConfigKeys =+      Set.fromList $+        Map.keys localConfig ++ Map.keys nsConfig ++ Map.keys ctxConfig ++ Map.keys globalConfig+    unusedConfigKeys =+      Set.toAscList (allConfigKeys `Set.difference` declaredNames)+    unresolvedOptional =+      [ d.name+      | d <- decls,+        not d.required,+        not (Map.member d.name resolved)+      ]
+ src/Seihou/Core/Version.hs view
@@ -0,0 +1,50 @@+module Seihou.Core.Version+  ( Version (..),+    parseVersion,+    renderVersion,+  )+where++import Data.Text qualified as T+import GHC.Generics (Generic)+import Numeric.Natural (Natural)+import Seihou.Prelude++-- | A parsed version consisting of numeric segments (e.g. @[1, 2, 3]@ for "1.2.3").+newtype Version = Version {segments :: [Natural]}+  deriving stock (Show, Generic)++instance Eq Version where+  Version a == Version b =+    let maxLen = max (length a) (length b)+     in pad maxLen a == pad maxLen b++instance Ord Version where+  compare (Version a) (Version b) =+    let maxLen = max (length a) (length b)+     in compare (pad maxLen a) (pad maxLen b)++-- | Pad a list of naturals with trailing zeros to the given length.+pad :: Int -> [Natural] -> [Natural]+pad n xs = xs ++ replicate (n - length xs) 0++-- | Parse a dotted version string like @"1.2.3"@ into a 'Version'.+-- Returns 'Nothing' for empty strings or strings with non-numeric segments.+parseVersion :: Text -> Maybe Version+parseVersion t+  | T.null t = Nothing+  | otherwise =+      let parts = T.splitOn "." t+       in case traverse readNatural parts of+            Just ns@(_ : _) -> Just (Version ns)+            _ -> Nothing++-- | Try to read a 'Natural' from a 'Text' value.+readNatural :: Text -> Maybe Natural+readNatural t = case reads (T.unpack t) of+  [(n, "")] | (n :: Integer) >= 0 -> Just (fromIntegral n)+  _ -> Nothing++-- | Render a 'Version' back to dotted notation.+renderVersion :: Version -> Text+renderVersion (Version ns) = T.intercalate "." (map (T.pack . show) ns)
+ src/Seihou/Dhall/Config.hs view
@@ -0,0 +1,99 @@+module Seihou.Dhall.Config+  ( evalConfigFile,+    evalConfigFileIfExists,+    serializeConfig,+    escapeDhallText,+  )+where++import Control.Exception (SomeException, try)+import Data.Map.Strict qualified as Map+import Data.Text qualified as T+import Data.Text.IO qualified as TIO+import Dhall (input, strictText)+import Dhall.Marshal.Decode (Decoder, field, list, record)+import Seihou.Prelude+import System.Directory (doesFileExist)++-- | Evaluate a Dhall config file to a @Map Text Text@.+--+-- Config files are plain Dhall records of text values, e.g.:+--+-- >  { license = "MIT", `project.name` = "my-app" }+--+-- This function reads the file, wraps the content with @toMap@ to convert+-- the record to a list of key-value entries, then decodes via the Dhall+-- library.+evalConfigFile :: FilePath -> IO (Map Text Text)+evalConfigFile path = do+  content <- TIO.readFile path+  let stripped = stripDhallComments content+  if isEmptyConfig stripped+    then pure Map.empty+    else input configMapDecoder ("toMap (" <> content <> ")")++-- | Check whether a stripped Dhall config expression is empty.+isEmptyConfig :: Text -> Bool+isEmptyConfig s = s `elem` ["{=}", "{ = }"] || T.null s++-- | Strip single-line Dhall comments (lines starting with @--@) and+-- whitespace, leaving only the meaningful Dhall expression.+stripDhallComments :: Text -> Text+stripDhallComments =+  T.strip . T.unlines . filter (not . isComment) . T.lines+  where+    isComment line' = "--" `T.isPrefixOf` T.stripStart line'++-- | Like 'evalConfigFile', but returns an empty map if the file does not exist.+-- Dhall parse/evaluation errors still propagate as 'Left'.+evalConfigFileIfExists :: FilePath -> IO (Either Text (Map Text Text))+evalConfigFileIfExists path = do+  exists <- doesFileExist path+  if exists+    then first formatError <$> try (evalConfigFile path)+    else pure (Right Map.empty)+  where+    formatError :: SomeException -> Text+    formatError e = "Error reading config " <> T.pack path <> ": " <> T.pack (show e)++-- | Serialize a @Map Text Text@ to valid Dhall source text.+--+-- Produces a multi-line record with backtick-escaped keys and Dhall text+-- literal values, using trailing-comma style:+--+-- >  { `key1` = "value1"+-- >  , `key2` = "value2"+-- >  }+--+-- An empty map produces @{=}@. Keys are sorted alphabetically for+-- deterministic output.+serializeConfig :: Map Text Text -> Text+serializeConfig m+  | Map.null m = "{=}\n"+  | otherwise =+      let entries = Map.toAscList m+          firstLine (k, v) = "{ `" <> k <> "` = \"" <> escapeDhallText v <> "\""+          restLine (k, v) = ", `" <> k <> "` = \"" <> escapeDhallText v <> "\""+          body = case entries of+            [] -> ""+            (e : es) -> T.unlines (firstLine e : map restLine es <> ["}"])+       in body++-- | Escape special characters inside a Dhall text literal.+--+-- Dhall text literals use double-quotes. Backslash and double-quote+-- must be escaped with a preceding backslash.+escapeDhallText :: Text -> Text+escapeDhallText = T.concatMap escapeChar+  where+    escapeChar '\\' = "\\\\"+    escapeChar '"' = "\\\""+    escapeChar c = T.singleton c++-- | Decoder for a list of @{ mapKey : Text, mapValue : Text }@ entries,+-- which is what @toMap { k = "v" }@ produces.+configMapDecoder :: Decoder (Map Text Text)+configMapDecoder = fmap Map.fromList (list entryDecoder)+  where+    entryDecoder :: Decoder (Text, Text)+    entryDecoder = record ((,) <$> field "mapKey" strictText <*> field "mapValue" strictText)
+ src/Seihou/Dhall/Eval.hs view
@@ -0,0 +1,762 @@+module Seihou.Dhall.Eval+  ( evalDhallExpr,+    evalModuleFromFile,+    evalRecipeFromFile,+    evalBlueprintFromFile,+    evalAgentPromptFromFile,+    evalRegistryFromFile,+    moduleDecoder,+    recipeDecoder,+    blueprintDecoder,+    agentPromptDecoder,+    commandVarDecoder,+    promptGuidanceDecoder,+    agentPromptLaunchDecoder,+    blueprintFileDecoder,+    registryDecoder,+    registryEntryDecoder,+    varTypeDecoder,+    varDeclDecoder,+    varExportDecoder,+    promptDecoder,+    stepDecoder,+    commandDecoder,+    strategyDecoder,+    patchOpDecoder,+    dependencyDecoder,+    removalDecoder,+    removalStepDecoder,+    removalActionDecoder,+    migrationDecoder,+    migrationOpDecoder,+  )+where++import Control.Exception (SomeException, evaluate, throwIO, try)+import Data.Either.Validation (Validation (..))+import Data.List (foldl')+import Data.Map.Strict qualified as Map+import Data.Text qualified as T+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 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.Src (Src)+import Seihou.Core.Expr (parseExpr)+import Seihou.Core.Migration (Migration (..), MigrationOp (..))+import Seihou.Core.Registry (Registry (..), RegistryEntry (..))+import Seihou.Core.Types+import Seihou.Core.Variable (coerceDefault)+import Seihou.Prelude+import System.FilePath (takeDirectory)+import Prelude hiding (maybe)++-- | Spike: evaluate a Dhall expression containing a record with @name@ and @version@+-- fields. Returns them as a 'Map'.+evalDhallExpr :: Text -> IO (Map Text Text)+evalDhallExpr expr = do+  (name, version) <- input simpleRecordDecoder expr+  pure (Map.fromList [("name", name), ("version", version)])++simpleRecordDecoder :: Decoder (Text, Text)+simpleRecordDecoder =+  record+    ( (,)+        <$> field "name" strictText+        <*> field "version" strictText+    )++-- | Evaluate a @module.dhall@ file and decode it into a 'Module' value.+-- Returns 'Left' with a 'ModuleLoadError' if evaluation or decoding fails.+--+-- Uses 'inputExprWithSettings' to parse, resolve imports, and normalize the+-- Dhall expression, then extracts with 'moduleDecoder' directly. This+-- bypasses Dhall's type-annotation check, allowing the @dependencies@ field+-- to be either @List Text@ (bare strings) or+-- @List { module : Text, vars : ... }@ (parameterized form) — the custom+-- 'dependencyDecoder' handles both at the AST level.+--+-- Note: Dhall 'Decoder' only supports 'Functor', so decoder helpers like+-- 'parseVarType' use 'error' for invalid input. These 'error' calls produce+-- lazy thunks inside the decoded 'Module'. We force evaluation of all+-- potentially-failing fields inside the 'try' block so that exceptions+-- are caught here rather than propagating as uncaught crashes later.+evalModuleFromFile :: FilePath -> IO (Either ModuleLoadError Module)+evalModuleFromFile path = do+  result <- try $ do+    text <- TIO.readFile path+    let settings =+          set rootDirectory (takeDirectory path) $+            set sourceName path defaultInputSettings+    expr <- inputExprWithSettings settings text+    case extract moduleDecoder expr of+      Success m -> do+        -- Force lazy decoder thunks that may contain 'error' calls+        mapM_ (\v -> evaluate v.type_) m.vars+        mapM_ (\s -> evaluate s.strategy >> evaluate s.condition >> mapM_ evaluate s.patch) m.steps+        mapM_ (\c -> mapM_ evaluate c.condition) m.commands+        mapM_ (\p -> evaluate p.condition) m.prompts+        pure m+      Failure e -> throwIO e+  case result of+    Left (e :: SomeException) ->+      let name = guessModuleName path+       in pure $ Left (DhallEvalError name (T.pack (show e)))+    Right m -> pure (Right m)++-- | Evaluate a @recipe.dhall@ file and decode it into a 'Recipe' value.+-- Returns 'Left' with a 'ModuleLoadError' if evaluation or decoding fails.+--+-- Follows the same pattern as 'evalModuleFromFile': uses+-- 'inputExprWithSettings' to parse and normalize, then extracts with+-- 'recipeDecoder'. The recipe's @modules@ field reuses 'dependencyDecoder'.+evalRecipeFromFile :: FilePath -> IO (Either ModuleLoadError Recipe)+evalRecipeFromFile path = do+  result <- try $ do+    text <- TIO.readFile path+    let settings =+          set rootDirectory (takeDirectory path) $+            set sourceName path defaultInputSettings+    expr <- inputExprWithSettings settings text+    case extract recipeDecoder expr of+      Success r -> do+        -- Force lazy decoder thunks that may contain 'error' calls+        mapM_ (\v -> evaluate v.type_) r.vars+        mapM_ (\p -> evaluate p.condition) r.prompts+        pure r+      Failure e -> throwIO e+  case result of+    Left (e :: SomeException) ->+      let name = guessModuleName path+       in pure $ Left (DhallEvalError name (T.pack (show e)))+    Right r -> pure (Right r)++-- | Guess a module name from its file path by taking the parent directory name.+guessModuleName :: FilePath -> ModuleName+guessModuleName path =+  let parts = T.splitOn "/" (T.pack path)+   in case parts of+        [] -> ModuleName "<unknown>"+        [_] -> ModuleName "<unknown>"+        _ ->+          let parentDir = parts !! (length parts - 2)+           in ModuleName parentDir++-- | Wrap a decoder to inject default values for missing record fields.+-- For each @(key, defaultExpr)@, if the key is absent from a 'RecordLit',+-- it is added with the given Dhall expression before extraction.+-- This allows decoders to handle schema evolution gracefully.+withDefaults :: [(Text, Dhall.Expr Src Void)] -> Decoder a -> Decoder a+withDefaults defaults (Decoder ext exp_) = Decoder ext' exp_+  where+    ext' expr@(Dhall.RecordLit fields) =+      let fields' = foldl' addDefault fields defaults+       in ext (Dhall.RecordLit fields')+    ext' expr = ext expr++    addDefault fs (k, v) =+      case DhallMap.lookup k fs of+        Just _ -> fs+        Nothing -> DhallMap.insert k (makeRecordField v) fs++-- | A Dhall expression representing @None Text@.+-- Used as a placeholder default for missing @Optional@-typed fields.+noneText :: Dhall.Expr Src Void+noneText = Dhall.App Dhall.None Dhall.Text++-- | Decoder for the top-level Module type from Dhall.+-- Uses 'withDefaults' to handle modules that predate the @removal@ and+-- @migrations@ fields.+moduleDecoder :: Decoder Module+moduleDecoder =+  withDefaults+    [ ("removal", noneText),+      ("migrations", emptyMigrationList)+    ]+    $ record+      ( Module+          <$> field "name" moduleNameDecoder+          <*> field "version" (maybe strictText)+          <*> field "description" (maybe strictText)+          <*> field "vars" (list varDeclDecoder)+          <*> field "exports" (list varExportDecoder)+          <*> field "prompts" (list promptDecoder)+          <*> field "steps" (list stepDecoder)+          <*> field "commands" (list commandDecoder)+          <*> field "dependencies" (list dependencyDecoder)+          <*> field "removal" (maybe removalDecoder)+          <*> field "migrations" (list migrationDecoder)+      )++-- | A Dhall expression representing an empty list of Migration records.+-- The list element type annotation is unused by the list extractor (which+-- ignores the annotation and reads element values), so we use a placeholder+-- type to keep the synthesized expression compact.+emptyMigrationList :: Dhall.Expr Src Void+emptyMigrationList = Dhall.ListLit (Just Dhall.Text) mempty++-- | Decoder for a single 'Migration' record.+migrationDecoder :: Decoder Migration+migrationDecoder =+  record+    ( Migration+        <$> field "from" strictText+        <*> field "to" strictText+        <*> field "ops" (list migrationOpDecoder)+    )++-- | Decoder for a 'MigrationOp' from a Dhall union value.+-- The union variants must match @schema/MigrationOp.dhall@.+migrationOpDecoder :: Decoder MigrationOp+migrationOpDecoder =+  union+    ( (mkMoveFile <$> constructor "MoveFile" srcDestRecord)+        <> (mkMoveDir <$> constructor "MoveDir" srcDestRecord)+        <> (mkDeleteFile <$> constructor "DeleteFile" pathRecord)+        <> (mkDeleteDir <$> constructor "DeleteDir" pathRecord)+        <> (mkRunCommand <$> constructor "RunCommand" runCommandRecord)+    )+  where+    srcDestRecord :: Decoder (FilePath, FilePath)+    srcDestRecord =+      record ((,) <$> field "src" string <*> field "dest" string)++    pathRecord :: Decoder FilePath+    pathRecord = record (field "path" string)++    runCommandRecord :: Decoder (Text, Maybe FilePath)+    runCommandRecord =+      record ((,) <$> field "run" strictText <*> field "workDir" (maybe string))++    mkMoveFile (s, d) = MoveFile {src = s, dest = d}+    mkMoveDir (s, d) = MoveDir {src = s, dest = d}+    mkDeleteFile p = DeleteFile {path = p}+    mkDeleteDir p = DeleteDir {path = p}+    mkRunCommand (r, wd) = RunCommand {run = r, workDir = wd}++-- | 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)+    )++recipeNameDecoder :: Decoder RecipeName+recipeNameDecoder = RecipeName <$> strictText++-- | Decoder for a 'BlueprintFile' record. The @src@ is a path relative+-- to the blueprint's @files/@ directory; the optional @description@ is+-- shown to the agent so it can pick the right reference.+blueprintFileDecoder :: Decoder BlueprintFile+blueprintFileDecoder =+  record+    ( BlueprintFile+        <$> field "src" string+        <*> field "description" (maybe strictText)+    )++-- | Decoder for the top-level Blueprint type from Dhall.+blueprintDecoder :: Decoder Blueprint+blueprintDecoder =+  record+    ( Blueprint+        <$> field "name" moduleNameDecoder+        <*> field "version" (maybe strictText)+        <*> field "description" (maybe strictText)+        <*> field "prompt" strictText+        <*> field "vars" (list varDeclDecoder)+        <*> field "prompts" (list promptDecoder)+        <*> field "baseModules" (list dependencyDecoder)+        <*> field "files" (list blueprintFileDecoder)+        <*> field "allowedTools" (maybe (list strictText))+        <*> field "tags" (list strictText)+    )++-- | Evaluate a @blueprint.dhall@ file and decode it into a 'Blueprint'.+-- Returns 'Left' with a 'ModuleLoadError' if evaluation or decoding fails.+--+-- Follows the same pattern as 'evalModuleFromFile' / 'evalRecipeFromFile':+-- uses 'inputExprWithSettings' to parse and normalize, then extracts with+-- 'blueprintDecoder' and forces lazy decoder thunks so 'error' calls in+-- the inner decoders are caught here rather than escaping later.+evalBlueprintFromFile :: FilePath -> IO (Either ModuleLoadError Blueprint)+evalBlueprintFromFile path = do+  result <- try $ do+    text <- TIO.readFile path+    let settings =+          set rootDirectory (takeDirectory path) $+            set sourceName path defaultInputSettings+    expr <- inputExprWithSettings settings text+    case extract blueprintDecoder expr of+      Success b -> do+        mapM_ (\v -> evaluate v.type_) b.vars+        mapM_ (\p -> evaluate p.condition) b.prompts+        pure b+      Failure e -> throwIO e+  case result of+    Left (e :: SomeException) ->+      let nm = guessModuleName path+       in pure $ Left (DhallEvalError nm (T.pack (show e)))+    Right b -> pure (Right b)++-- | Decoder for a 'CommandVar' record.+commandVarDecoder :: Decoder CommandVar+commandVarDecoder =+  record+    ( mkCommandVar+        <$> field "name" varNameDecoder+        <*> field "run" strictText+        <*> field "workDir" (maybe strictText)+        <*> field "when" (maybe strictText)+        <*> field "trim" bool+        <*> field "maxBytes" (maybe natural)+    )+  where+    mkCommandVar name run workDir whenText trim maxBytes =+      CommandVar+        { name = name,+          run = run,+          workDir = workDir,+          condition = parseWhen whenText,+          trim = trim,+          maxBytes = maxBytes+        }++-- | Decoder for optional agent prompt launch metadata.+agentPromptLaunchDecoder :: Decoder AgentPromptLaunch+agentPromptLaunchDecoder =+  record+    ( AgentPromptLaunch+        <$> field "provider" (maybe strictText)+        <*> field "mode" (maybe strictText)+        <*> field "model" (maybe strictText)+    )++-- | Decoder for a prompt guidance block.+promptGuidanceDecoder :: Decoder PromptGuidance+promptGuidanceDecoder =+  record+    ( mkPromptGuidance+        <$> field "title" strictText+        <*> field "body" strictText+        <*> field "when" (maybe strictText)+    )+  where+    mkPromptGuidance title body whenText =+      PromptGuidance+        { title = title,+          body = body,+          condition = parseWhen whenText+        }++-- | Decoder for the top-level AgentPrompt type from Dhall.+agentPromptDecoder :: Decoder AgentPrompt+agentPromptDecoder =+  withDefaults [("guidance", emptyPromptGuidanceList)] $+    record+      ( AgentPrompt+          <$> field "name" moduleNameDecoder+          <*> field "version" (maybe strictText)+          <*> field "description" (maybe strictText)+          <*> field "prompt" strictText+          <*> field "vars" (list varDeclDecoder)+          <*> field "prompts" (list promptDecoder)+          <*> field "commandVars" (list commandVarDecoder)+          <*> field "guidance" (list promptGuidanceDecoder)+          <*> field "files" (list blueprintFileDecoder)+          <*> field "allowedTools" (maybe (list strictText))+          <*> field "tags" (list strictText)+          <*> field "launch" (maybe agentPromptLaunchDecoder)+      )++emptyPromptGuidanceList :: Dhall.Expr Src Void+emptyPromptGuidanceList = Dhall.ListLit (Just Dhall.Text) mempty++-- | Evaluate a @prompt.dhall@ file and decode it into an 'AgentPrompt'.+evalAgentPromptFromFile :: FilePath -> IO (Either ModuleLoadError AgentPrompt)+evalAgentPromptFromFile path = do+  result <- try $ do+    text <- TIO.readFile path+    let settings =+          set rootDirectory (takeDirectory path) $+            set sourceName path defaultInputSettings+    expr <- inputExprWithSettings settings text+    case extract agentPromptDecoder expr of+      Success p -> do+        mapM_ (\v -> evaluate v.type_) p.vars+        mapM_ (\prompt -> evaluate prompt.condition) p.prompts+        mapM_ (\cv -> evaluate cv.condition) p.commandVars+        mapM_ (\g -> evaluate g.condition) p.guidance+        pure p+      Failure e -> throwIO e+  case result of+    Left (e :: SomeException) ->+      let nm = guessModuleName path+       in pure $ Left (DhallEvalError nm (T.pack (show e)))+    Right p -> pure (Right p)++-- | Decoder for Removal from a Dhall record.+removalDecoder :: Decoder Removal+removalDecoder =+  record+    ( Removal+        <$> field "steps" (list removalStepDecoder)+        <*> field "commands" (list commandDecoder)+    )++-- | Decoder for RemovalStep from a Dhall record.+removalStepDecoder :: Decoder RemovalStep+removalStepDecoder =+  record+    ( RemovalStep+        <$> field "action" removalActionDecoder+        <*> field "dest" strictText+        <*> field "src" (maybe string)+    )++-- | Decoder for RemovalAction from a Dhall Text string.+--+-- See 'varTypeDecoder' note re: 'error' safety.+removalActionDecoder :: Decoder RemovalAction+removalActionDecoder = parseRemovalAction <$> strictText+  where+    parseRemovalAction :: Text -> RemovalAction+    parseRemovalAction t = case t of+      "remove-file" -> RemoveFileAction+      "remove-section" -> RemoveSectionAction+      "rewrite-file" -> RewriteFileAction+      -- Caught by 'try' in 'evalModuleFromFile'+      other -> error ("Unknown removal action \"" <> T.unpack other <> "\"; expected one of: remove-file, remove-section, rewrite-file")++moduleNameDecoder :: Decoder ModuleName+moduleNameDecoder = ModuleName <$> strictText++-- | Decoder for a dependency entry.+-- Accepts two Dhall forms for backward compatibility:+--+-- 1. A bare text string: @"base"@ decodes as @Dependency "base" mempty@.+-- 2. A record: @{ module = "base", vars = [ { name = "x", value = "y" } ] }@+--    decodes as @Dependency "base" (fromList [("x", "y")])@.+--+-- This is implemented as a custom decoder that pattern-matches on the Dhall+-- expression AST: 'TextLit' for bare strings, falling back to the record+-- decoder for the parameterized form.+dependencyDecoder :: Decoder Dependency+dependencyDecoder = Decoder extractDep expectedDep+  where+    extractDep :: Dhall.Expr Src Void -> Extractor Src Void Dependency+    extractDep (Dhall.TextLit (Chunks [] t)) =+      pure (simpleDep (ModuleName t))+    extractDep expr =+      extract paramDepDecoder expr++    expectedDep = expected strictText++    paramDepDecoder :: Decoder Dependency+    paramDepDecoder =+      record+        ( mkDep+            <$> field "module" moduleNameDecoder+            <*> field "vars" (list varBindingDecoder)+        )++    varBindingDecoder :: Decoder (VarName, Text)+    varBindingDecoder =+      record+        ( (,)+            <$> field "name" varNameDecoder+            <*> field "value" strictText+        )++    mkDep :: ModuleName -> [(VarName, Text)] -> Dependency+    mkDep name bindings = Dependency {depModule = name, depVars = Map.fromList bindings}++-- | Decoder for VarType from a Dhall Text string.+-- Dhall does not support recursive types, so VarType is represented as a+-- string: @"text"@, @"bool"@, @"int"@, @"list text"@, @"list bool"@,+-- @"list int"@, @"choice"@.+--+-- Note: 'Decoder' only has a 'Functor' instance (no 'Monad'/'MonadFail'), so+-- we cannot use @fail@ for error reporting. The 'error' call throws an+-- 'ErrorCall' exception that is caught by @try@ in 'evalModuleFromFile' and+-- wrapped as @Left (DhallEvalError ...)@.+varTypeDecoder :: Decoder VarType+varTypeDecoder = parseVarType <$> strictText+  where+    parseVarType :: Text -> VarType+    parseVarType t = case T.toLower t of+      "text" -> VTText+      "bool" -> VTBool+      "int" -> VTInt+      "choice" -> VTChoice []+      other+        | "list " `T.isPrefixOf` other ->+            VTList (parseVarType (T.drop 5 other))+        | otherwise ->+            -- Caught by 'try' in 'evalModuleFromFile'+            error ("Unknown var type \"" <> T.unpack other <> "\"; expected one of: text, bool, int, choice, list <type>")++-- | Decoder for Strategy from a Dhall Text string.+--+-- See 'varTypeDecoder' note re: 'error' safety.+strategyDecoder :: Decoder Strategy+strategyDecoder = parseStrategy <$> strictText+  where+    parseStrategy :: Text -> Strategy+    parseStrategy t = case t of+      "copy" -> Copy+      "template" -> Template+      "dhall-text" -> DhallText+      "structured" -> Structured+      -- Caught by 'try' in 'evalModuleFromFile'+      other -> error ("Unknown strategy \"" <> T.unpack other <> "\"; expected one of: copy, template, dhall-text, structured")++-- | Decoder for VarDecl from a Dhall record.+--+-- The @default@ field is decoded as raw text and then coerced against the+-- declared @type@ via 'coerceDeclDefault', so a defaulted variable carries the+-- correctly-typed 'VarValue' for every downstream consumer (e.g. a @bool@+-- default of @"true"@ becomes 'VBool' 'True'). A default that cannot be coerced+-- is an authoring error and fails module load (caught by 'try' in+-- 'evalModuleFromFile'; see the 'varTypeDecoder' note re: 'error' safety).+varDeclDecoder :: Decoder VarDecl+varDeclDecoder =+  fmap coerceDeclDefault $+    record+      ( VarDecl+          <$> field "name" varNameDecoder+          <*> field "type" varTypeDecoder+          <*> field "default" (fmap (fmap VText) (maybe strictText))+          <*> field "description" (maybe strictText)+          <*> field "required" bool+          <*> field "validation" (fmap (fmap ValPattern) (maybe strictText))+      )++-- | Coerce a decoded variable declaration's raw-text default against its+-- declared type. On a type mismatch we 'error' with a clear, load-time message+-- that names the variable and the offending value; this is caught by 'try' in+-- 'evalModuleFromFile' and surfaced as a 'DhallEvalError'.+coerceDeclDefault :: VarDecl -> VarDecl+coerceDeclDefault decl =+  case decl.default_ of+    Nothing -> decl+    Just rawDefault ->+      case coerceDefault decl.name decl.type_ rawDefault of+        Right val -> decl {default_ = Just val}+        -- Caught by 'try' in 'evalModuleFromFile'+        Left err -> error (T.unpack (renderDefaultError decl.name err))++-- | Render a coercion failure for a module default into a load-time message.+renderDefaultError :: VarName -> VarError -> Text+renderDefaultError name (CoercionFailed _ ty raw) =+  "Invalid default for variable '"+    <> name.unVarName+    <> "': cannot coerce "+    <> T.pack (show raw)+    <> " to declared type "+    <> renderVarType ty+renderDefaultError name err =+  "Invalid default for variable '" <> name.unVarName <> "': " <> T.pack (show err)++-- | A short rendering of a declared variable type for error messages.+renderVarType :: VarType -> Text+renderVarType VTText = "text"+renderVarType VTBool = "bool"+renderVarType VTInt = "int"+renderVarType (VTList ty) = "list " <> renderVarType ty+renderVarType (VTChoice _) = "choice"++varNameDecoder :: Decoder VarName+varNameDecoder = VarName <$> strictText++-- | Decoder for VarExport from a Dhall record.+-- Note: the Dhall field is @alias@ rather than @as@ because @as@ is a+-- reserved keyword in Dhall.+varExportDecoder :: Decoder VarExport+varExportDecoder =+  record+    ( VarExport+        <$> field "var" varNameDecoder+        <*> field "alias" (fmap (fmap VarName) (maybe strictText))+    )++-- | Decoder for Prompt from a Dhall record.+-- The @when@ field is parsed via 'parseExpr' into an 'Expr' AST.+-- Parse failures are treated as fatal (via 'error') since they indicate a+-- malformed module definition.+promptDecoder :: Decoder Prompt+promptDecoder =+  record+    ( mkPrompt+        <$> field "var" varNameDecoder+        <*> field "text" strictText+        <*> field "when" (maybe strictText)+        <*> field "choices" (maybe (list strictText))+    )+  where+    mkPrompt v t whenText choices =+      Prompt+        { var = v,+          text = t,+          condition = parseWhen whenText,+          choices = choices+        }++-- | Decoder for PatchOp from a Dhall Text string.+--+-- See 'varTypeDecoder' note re: 'error' safety.+patchOpDecoder :: Decoder PatchOp+patchOpDecoder = parsePatchOp <$> strictText+  where+    parsePatchOp :: Text -> PatchOp+    parsePatchOp t = case t of+      "append-file" -> AppendFile+      "prepend-file" -> PrependFile+      "append-section" -> AppendSection+      "append-line-if-absent" -> AppendLineIfAbsent+      -- Caught by 'try' in 'evalModuleFromFile'+      other -> error ("Unknown patch operation \"" <> T.unpack other <> "\"; expected one of: append-file, prepend-file, append-section, append-line-if-absent")++-- | Decoder for Step from a Dhall record.+-- The @when@ field is parsed via 'parseExpr' into an 'Expr' AST.+-- The @patch@ field is an optional patch operation string.+stepDecoder :: Decoder Step+stepDecoder =+  record+    ( mkStep+        <$> field "strategy" strategyDecoder+        <*> field "src" string+        <*> field "dest" strictText+        <*> field "when" (maybe strictText)+        <*> field "patch" (maybe strictText)+    )+  where+    mkStep strat src dest whenText patchText =+      Step+        { strategy = strat,+          src = src,+          dest = dest,+          condition = parseWhen whenText,+          patch = fmap parsePatchOp patchText+        }+    parsePatchOp "append-file" = AppendFile+    parsePatchOp "prepend-file" = PrependFile+    parsePatchOp "append-section" = AppendSection+    parsePatchOp "append-line-if-absent" = AppendLineIfAbsent+    parsePatchOp other = error ("Unknown patch operation \"" <> T.unpack other <> "\"; expected one of: append-file, prepend-file, append-section, append-line-if-absent")++-- | Decoder for Command from a Dhall record.+-- The @when@ field is parsed via 'parseExpr' into an 'Expr' AST.+commandDecoder :: Decoder Command+commandDecoder =+  record+    ( mkCommand+        <$> field "run" strictText+        <*> field "workDir" (maybe strictText)+        <*> field "when" (maybe strictText)+    )+  where+    mkCommand run workDir whenText =+      Command+        { run = run,+          workDir = workDir,+          condition = parseWhen whenText+        }++-- | Parse an optional @when@ expression text into an 'Expr'.+-- Returns 'Nothing' for 'Nothing' input, 'Just expr' on success, or calls+-- 'error' on a malformed expression. The 'error' is caught by @try@ in+-- 'evalModuleFromFile' (see 'varTypeDecoder' note).+parseWhen :: Maybe Text -> Maybe Expr+parseWhen Nothing = Nothing+parseWhen (Just t) = case parseExpr t of+  Right expr -> Just expr+  -- Caught by 'try' in 'evalModuleFromFile'+  Left err -> error ("Invalid when expression \"" <> T.unpack t <> "\": " <> T.unpack err)++-- | Decoder for a single registry entry from a Dhall record.+-- Uses 'withDefaults' to handle registries that omit the @version@ field.+registryEntryDecoder :: Decoder RegistryEntry+registryEntryDecoder =+  withDefaults [("version", noneText)] $+    record+      ( RegistryEntry+          <$> field "name" moduleNameDecoder+          <*> field "version" (maybe strictText)+          <*> field "path" string+          <*> field "description" (maybe strictText)+          <*> field "tags" (list strictText)+      )++-- | Decoder for a registry metadata file from Dhall.+-- Uses 'withDefaults' to handle registries that omit the @recipes@ or+-- @blueprints@ or @prompts@ field (backwards compatibility with existing+-- seihou-registry.dhall files).+registryDecoder :: Decoder Registry+registryDecoder =+  withDefaults+    [ ("recipes", emptyRegistryEntryList),+      ("blueprints", emptyRegistryEntryList),+      ("prompts", emptyRegistryEntryList)+    ]+    $ record+      ( Registry+          <$> field "repoName" strictText+          <*> field "repoDescription" (maybe strictText)+          <*> field "modules" (list registryEntryDecoder)+          <*> field "recipes" (list registryEntryDecoder)+          <*> field "blueprints" (list registryEntryDecoder)+          <*> field "prompts" (list registryEntryDecoder)+      )++-- | A Dhall expression representing an empty list of registry entries.+-- Used as a default for the @recipes@ field in registries that predate recipe support.+emptyRegistryEntryList :: Dhall.Expr Src Void+emptyRegistryEntryList =+  Dhall.ListLit+    ( Just+        ( Dhall.Record+            ( DhallMap.fromList+                [ ("name", makeRecordField Dhall.Text),+                  ("version", makeRecordField (Dhall.App Dhall.Optional Dhall.Text)),+                  ("path", makeRecordField Dhall.Text),+                  ("description", makeRecordField (Dhall.App Dhall.Optional Dhall.Text)),+                  ("tags", makeRecordField (Dhall.App Dhall.List Dhall.Text))+                ]+            )+        )+    )+    mempty++-- | Evaluate a @seihou-registry.dhall@ file and decode it into a 'Registry'.+-- Returns 'Left' with a 'RegistryEvalError' if evaluation or decoding fails.+--+-- Uses 'inputExprWithSettings' to parse, resolve imports, and normalize the+-- Dhall expression, then extracts with 'registryDecoder' directly. This+-- bypasses Dhall's type-annotation check, allowing registry entries to omit+-- optional fields like @version@ — the custom 'registryEntryDecoder' handles+-- missing fields at the AST level.+evalRegistryFromFile :: FilePath -> IO (Either ModuleLoadError Registry)+evalRegistryFromFile path = do+  result <- try $ do+    text <- TIO.readFile path+    let settings =+          set rootDirectory (takeDirectory path) $+            set sourceName path defaultInputSettings+    expr <- inputExprWithSettings settings text+    case extract registryDecoder expr of+      Success r -> pure r+      Failure e -> throwIO e+  case result of+    Left (e :: SomeException) ->+      pure $ Left (RegistryEvalError (T.pack path) (T.pack (show e)))+    Right r -> pure (Right r)
+ src/Seihou/Effect/ConfigReader.hs view
@@ -0,0 +1,31 @@+module Seihou.Effect.ConfigReader+  ( ConfigReader (..),+    readGlobalConfig,+    readLocalConfig,+    readNamespaceConfig,+    readContextConfig,+  )+where++import Seihou.Core.Types (ConfigError)+import Seihou.Prelude++data ConfigReader :: Effect where+  ReadGlobalConfig :: ConfigReader m (Either ConfigError (Map Text Text))+  ReadLocalConfig :: ConfigReader m (Either ConfigError (Map Text Text))+  ReadNamespaceConfig :: Text -> ConfigReader m (Either ConfigError (Map Text Text))+  ReadContextConfig :: Text -> ConfigReader m (Either ConfigError (Map Text Text))++type instance DispatchOf ConfigReader = Dynamic++readGlobalConfig :: (ConfigReader :> es) => Eff es (Either ConfigError (Map Text Text))+readGlobalConfig = send ReadGlobalConfig++readLocalConfig :: (ConfigReader :> es) => Eff es (Either ConfigError (Map Text Text))+readLocalConfig = send ReadLocalConfig++readNamespaceConfig :: (ConfigReader :> es) => Text -> Eff es (Either ConfigError (Map Text Text))+readNamespaceConfig ns = send (ReadNamespaceConfig ns)++readContextConfig :: (ConfigReader :> es) => Text -> Eff es (Either ConfigError (Map Text Text))+readContextConfig ctx = send (ReadContextConfig ctx)
+ src/Seihou/Effect/ConfigReaderInterp.hs view
@@ -0,0 +1,48 @@+module Seihou.Effect.ConfigReaderInterp+  ( runConfigReader,+  )+where++import Data.Map.Strict qualified as Map+import Data.Text qualified as T+import Seihou.Core.Types (ConfigError (..))+import Seihou.Dhall.Config (evalConfigFileIfExists)+import Seihou.Effect.ConfigReader (ConfigReader (..))+import Seihou.Prelude+import System.Directory (XdgDirectory (..), getCurrentDirectory, getXdgDirectory)++-- | Real IO interpreter for the ConfigReader effect.+--+-- Resolves config file paths using standard locations:+--+--   * Global: @~\/.config\/seihou\/config.dhall@+--   * Local: @.seihou\/config.dhall@ (relative to current directory)+--   * Namespace: @~\/.config\/seihou\/namespaces\/\<ns\>\/config.dhall@+--   * Context: @~\/.config\/seihou\/contexts\/\<ctx\>\/config.dhall@+--+-- Missing files are silently treated as empty maps. Invalid Dhall+-- is reported as @Left (ConfigParseError ...)@.+runConfigReader :: (IOE :> es) => Eff (ConfigReader : es) a -> Eff es a+runConfigReader = interpret $ \_ -> \case+  ReadGlobalConfig -> liftIO $ do+    base <- getXdgDirectory XdgConfig "seihou"+    let path = base </> "config.dhall"+    first (ConfigParseError path) <$> evalConfigFileIfExists path+  ReadLocalConfig -> liftIO $ do+    cwd <- getCurrentDirectory+    let path = cwd </> ".seihou" </> "config.dhall"+    first (ConfigParseError path) <$> evalConfigFileIfExists path+  ReadNamespaceConfig ns -> liftIO $ loadNamespacedConfig "namespaces" ns "namespace must not contain '..' or '/'"+  ReadContextConfig ctx -> liftIO $ loadNamespacedConfig "contexts" ctx "context name must not contain '..' or '/'"++-- | Load config from a named subdirectory under XDG config, with path-traversal validation.+loadNamespacedConfig :: String -> Text -> Text -> IO (Either ConfigError (Map Text Text))+loadNamespacedConfig subdir name errMsg+  | T.null name = pure (Right Map.empty)+  | hasPathTraversal name = pure (Left (InvalidNamespace name errMsg))+  | otherwise = do+      base <- getXdgDirectory XdgConfig "seihou"+      let path = base </> subdir </> T.unpack name </> "config.dhall"+      first (ConfigParseError path) <$> evalConfigFileIfExists path+  where+    hasPathTraversal t = ".." `T.isInfixOf` t || "/" `T.isInfixOf` t
+ src/Seihou/Effect/ConfigReaderPure.hs view
@@ -0,0 +1,32 @@+module Seihou.Effect.ConfigReaderPure+  ( runConfigReaderPure,+  )+where++import Data.Map.Strict qualified as Map+import Seihou.Effect.ConfigReader (ConfigReader (..))+import Seihou.Prelude++-- | Pure interpreter for the ConfigReader effect.+--+-- Takes four scripted config maps:+--+--   * @localConfig@: the local project config (.seihou\/config.dhall)+--   * @namespaceConfigs@: a map from namespace names to their configs+--   * @contextConfigs@: a map from context names to their configs+--   * @globalConfig@: the global config (~\/.config\/seihou\/config.dhall)+--+-- This allows tests to provide exact config values without touching the filesystem.+-- All operations return 'Right' (success) since the pure interpreter has no parse errors.+runConfigReaderPure ::+  Map Text Text ->+  Map Text (Map Text Text) ->+  Map Text (Map Text Text) ->+  Map Text Text ->+  Eff (ConfigReader : es) a ->+  Eff es a+runConfigReaderPure localConfig namespaceConfigs contextConfigs globalConfig = interpret $ \_ -> \case+  ReadGlobalConfig -> pure (Right globalConfig)+  ReadLocalConfig -> pure (Right localConfig)+  ReadNamespaceConfig ns -> pure (Right (Map.findWithDefault Map.empty ns namespaceConfigs))+  ReadContextConfig ctx -> pure (Right (Map.findWithDefault Map.empty ctx contextConfigs))
+ src/Seihou/Effect/ConfigWriter.hs view
@@ -0,0 +1,26 @@+module Seihou.Effect.ConfigWriter+  ( ConfigWriter (..),+    writeConfigValue,+    deleteConfigValue,+    listConfigValues,+  )+where++import Seihou.Core.Types (ConfigError, ConfigScope)+import Seihou.Prelude++data ConfigWriter :: Effect where+  WriteConfigValue :: ConfigScope -> Text -> Text -> ConfigWriter m ()+  DeleteConfigValue :: ConfigScope -> Text -> ConfigWriter m ()+  ListConfigValues :: ConfigScope -> ConfigWriter m (Either ConfigError (Map Text Text))++type instance DispatchOf ConfigWriter = Dynamic++writeConfigValue :: (ConfigWriter :> es) => ConfigScope -> Text -> Text -> Eff es ()+writeConfigValue scope key val = send (WriteConfigValue scope key val)++deleteConfigValue :: (ConfigWriter :> es) => ConfigScope -> Text -> Eff es ()+deleteConfigValue scope key = send (DeleteConfigValue scope key)++listConfigValues :: (ConfigWriter :> es) => ConfigScope -> Eff es (Either ConfigError (Map Text Text))+listConfigValues scope = send (ListConfigValues scope)
+ src/Seihou/Effect/ConfigWriterInterp.hs view
@@ -0,0 +1,77 @@+module Seihou.Effect.ConfigWriterInterp+  ( runConfigWriter,+  )+where++import Data.Map.Strict qualified as Map+import Data.Text qualified as T+import Data.Text.IO qualified as TIO+import Seihou.Core.Types (ConfigError (..), ConfigScope (..))+import Seihou.Dhall.Config (evalConfigFileIfExists, serializeConfig)+import Seihou.Effect.ConfigWriter (ConfigWriter (..))+import Seihou.Prelude+import System.Directory+  ( XdgDirectory (..),+    createDirectoryIfMissing,+    getCurrentDirectory,+    getXdgDirectory,+  )+import System.FilePath (takeDirectory)++-- | IO interpreter for the ConfigWriter effect.+--+-- Performs read-modify-write on Dhall config files. Creates parent+-- directories as needed. Path resolution matches 'ConfigReaderInterp':+--+--   * 'ScopeLocal': @.seihou\/config.dhall@ relative to cwd+--   * 'ScopeNamespace' ns: @~\/.config\/seihou\/namespaces\/\<ns\>\/config.dhall@+--   * 'ScopeContext' ctx: @~\/.config\/seihou\/contexts\/\<ctx\>\/config.dhall@+--   * 'ScopeGlobal': @~\/.config\/seihou\/config.dhall@+runConfigWriter :: (IOE :> es) => Eff (ConfigWriter : es) a -> Eff es a+runConfigWriter = interpret $ \_ -> \case+  WriteConfigValue scope key val -> liftIO $ do+    path <- resolvePath scope+    m <- readOrEmpty path+    let updated = Map.insert key val m+    ensureParent path+    TIO.writeFile path (serializeConfig updated)+  DeleteConfigValue scope key -> liftIO $ do+    path <- resolvePath scope+    m <- readOrEmpty path+    let updated = Map.delete key m+    ensureParent path+    TIO.writeFile path (serializeConfig updated)+  ListConfigValues scope -> liftIO $ do+    path <- resolvePath scope+    result <- evalConfigFileIfExists path+    case result of+      Left err -> pure (Left (ConfigParseError path err))+      Right m -> pure (Right m)++-- | Resolve the config file path for a given scope.+resolvePath :: ConfigScope -> IO FilePath+resolvePath ScopeLocal = do+  cwd <- getCurrentDirectory+  pure (cwd </> ".seihou" </> "config.dhall")+resolvePath (ScopeNamespace ns) = do+  base <- getXdgDirectory XdgConfig "seihou"+  pure (base </> "namespaces" </> T.unpack ns </> "config.dhall")+resolvePath (ScopeContext ctx) = do+  base <- getXdgDirectory XdgConfig "seihou"+  pure (base </> "contexts" </> T.unpack ctx </> "config.dhall")+resolvePath ScopeGlobal = do+  base <- getXdgDirectory XdgConfig "seihou"+  pure (base </> "config.dhall")++-- | Read an existing config file, returning an empty map if the file+-- does not exist. Throws on Dhall parse errors.+readOrEmpty :: FilePath -> IO (Map.Map T.Text T.Text)+readOrEmpty path = do+  result <- evalConfigFileIfExists path+  case result of+    Left err -> fail (T.unpack err)+    Right m -> pure m++-- | Create parent directories for a file path if they don't exist.+ensureParent :: FilePath -> IO ()+ensureParent path = createDirectoryIfMissing True (takeDirectory path)
+ src/Seihou/Effect/ConfigWriterPure.hs view
@@ -0,0 +1,67 @@+module Seihou.Effect.ConfigWriterPure+  ( runConfigWriterPure,+    ConfigWriterState (..),+    emptyConfigWriterState,+  )+where++import Data.Map.Strict qualified as Map+import Effectful.State.Static.Local (State, get, modify, runState)+import Seihou.Core.Types (ConfigScope (..))+import Seihou.Effect.ConfigWriter (ConfigWriter (..))+import Seihou.Prelude++-- | In-memory state for the pure ConfigWriter interpreter.+data ConfigWriterState = ConfigWriterState+  { cwLocal :: Map Text Text,+    cwNamespaces :: Map Text (Map Text Text),+    cwGlobal :: Map Text Text+  }+  deriving stock (Eq, Show)++-- | Empty initial state with no config values in any scope.+emptyConfigWriterState :: ConfigWriterState+emptyConfigWriterState =+  ConfigWriterState+    { cwLocal = Map.empty,+      cwNamespaces = Map.empty,+      cwGlobal = Map.empty+    }++-- | Pure interpreter for the ConfigWriter effect using in-memory state.+--+-- Returns the result along with the final state, allowing tests to+-- inspect what was written.+runConfigWriterPure :: ConfigWriterState -> Eff (ConfigWriter : es) a -> Eff es (a, ConfigWriterState)+runConfigWriterPure initial = reinterpret (runState initial) handler+  where+    handler :: (State ConfigWriterState :> es') => EffectHandler ConfigWriter es'+    handler _ = \case+      WriteConfigValue scope key val ->+        modify @ConfigWriterState (writeToScope scope key val)+      DeleteConfigValue scope key ->+        modify @ConfigWriterState (deleteFromScope scope key)+      ListConfigValues scope -> do+        st <- get @ConfigWriterState+        pure (Right (readScope scope st))++writeToScope :: ConfigScope -> Text -> Text -> ConfigWriterState -> ConfigWriterState+writeToScope ScopeLocal key val st = st {cwLocal = Map.insert key val st.cwLocal}+writeToScope (ScopeNamespace ns) key val st =+  let nsMap = Map.findWithDefault Map.empty ns st.cwNamespaces+      updated = Map.insert key val nsMap+   in st {cwNamespaces = Map.insert ns updated st.cwNamespaces}+writeToScope ScopeGlobal key val st = st {cwGlobal = Map.insert key val st.cwGlobal}++deleteFromScope :: ConfigScope -> Text -> ConfigWriterState -> ConfigWriterState+deleteFromScope ScopeLocal key st = st {cwLocal = Map.delete key st.cwLocal}+deleteFromScope (ScopeNamespace ns) key st =+  let nsMap = Map.findWithDefault Map.empty ns st.cwNamespaces+      updated = Map.delete key nsMap+   in st {cwNamespaces = Map.insert ns updated st.cwNamespaces}+deleteFromScope ScopeGlobal key st = st {cwGlobal = Map.delete key st.cwGlobal}++readScope :: ConfigScope -> ConfigWriterState -> Map Text Text+readScope ScopeLocal st = st.cwLocal+readScope (ScopeNamespace ns) st = Map.findWithDefault Map.empty ns st.cwNamespaces+readScope ScopeGlobal st = st.cwGlobal
+ src/Seihou/Effect/Console.hs view
@@ -0,0 +1,36 @@+module Seihou.Effect.Console+  ( Console (..),+    putText,+    putError,+    getLine,+    confirm,+    isInteractive,+  )+where++import Seihou.Prelude+import Prelude hiding (getLine)++data Console :: Effect where+  PutText :: Text -> Console m ()+  PutError :: Text -> Console m ()+  GetLine :: Console m Text+  Confirm :: Text -> Console m Bool+  IsInteractive :: Console m Bool++type instance DispatchOf Console = Dynamic++putText :: (Console :> es) => Text -> Eff es ()+putText msg = send (PutText msg)++putError :: (Console :> es) => Text -> Eff es ()+putError msg = send (PutError msg)++getLine :: (Console :> es) => Eff es Text+getLine = send GetLine++confirm :: (Console :> es) => Text -> Eff es Bool+confirm prompt = send (Confirm prompt)++isInteractive :: (Console :> es) => Eff es Bool+isInteractive = send IsInteractive
+ src/Seihou/Effect/ConsoleInterp.hs view
@@ -0,0 +1,28 @@+module Seihou.Effect.ConsoleInterp+  ( runConsole,+  )+where++import Data.Text qualified as T+import Data.Text.IO qualified as TIO+import Seihou.Effect.Console (Console (..))+import Seihou.Prelude+import System.IO (hFlush, hIsTerminalDevice, hPutStrLn, stderr, stdin, stdout)+import Prelude hiding (getLine)++-- | Real IO interpreter for the Console effect.+-- Writes output to stdout, errors to stderr, reads from stdin.+-- TTY detection uses 'hIsTerminalDevice' on stdin.+runConsole :: (IOE :> es) => Eff (Console : es) a -> Eff es a+runConsole = interpret $ \_ -> \case+  PutText msg -> liftIO $ TIO.putStrLn msg+  PutError msg -> liftIO $ hPutStrLn stderr (T.unpack msg)+  GetLine -> liftIO $ do+    hFlush stdout+    TIO.getLine+  Confirm prompt -> liftIO $ do+    TIO.putStr (prompt <> " [y/n] ")+    hFlush stdout+    answer <- TIO.getLine+    pure (T.toLower (T.strip answer) `elem` ["y", "yes"])+  IsInteractive -> liftIO $ hIsTerminalDevice stdin
+ src/Seihou/Effect/ConsolePure.hs view
@@ -0,0 +1,58 @@+module Seihou.Effect.ConsolePure+  ( runConsolePure,+    runConsolePureNonInteractive,+    ConsoleState (..),+    emptyConsoleState,+  )+where++import Effectful.State.Static.Local (State, get, modify, runState)+import Seihou.Effect.Console (Console (..))+import Seihou.Prelude+import Prelude hiding (getLine)++-- | State for the pure Console interpreter.+data ConsoleState = ConsoleState+  { consoleInputs :: [Text],+    consoleOutputs :: [Text],+    consoleErrors :: [Text]+  }+  deriving stock (Eq, Show)++-- | Empty console state with no inputs or outputs.+emptyConsoleState :: ConsoleState+emptyConsoleState = ConsoleState [] [] []++-- | Pure interpreter for the Console effect (interactive mode).+-- Takes a list of scripted input lines. IsInteractive returns True.+runConsolePure :: [Text] -> Eff (Console : es) a -> Eff es (a, ConsoleState)+runConsolePure inputs = reinterpret (runState (ConsoleState inputs [] [])) handler+  where+    handler :: (State ConsoleState :> es') => EffectHandler Console es'+    handler _ = \case+      PutText msg -> modify @ConsoleState (\s -> s {consoleOutputs = s.consoleOutputs ++ [msg]})+      PutError msg -> modify @ConsoleState (\s -> s {consoleErrors = s.consoleErrors ++ [msg]})+      GetLine -> popInput+      Confirm _prompt -> (`elem` ["y", "yes"]) <$> popInput+      IsInteractive -> pure True++    popInput :: (State ConsoleState :> es') => Eff es' Text+    popInput = do+      s <- get @ConsoleState+      case s.consoleInputs of+        [] -> pure ""+        (x : xs) -> do+          modify @ConsoleState (\st -> st {consoleInputs = xs})+          pure x++-- | Pure interpreter for non-interactive mode. IsInteractive returns False.+runConsolePureNonInteractive :: Eff (Console : es) a -> Eff es (a, ConsoleState)+runConsolePureNonInteractive = reinterpret (runState emptyConsoleState) handler+  where+    handler :: (State ConsoleState :> es') => EffectHandler Console es'+    handler _ = \case+      PutText msg -> modify @ConsoleState (\s -> s {consoleOutputs = s.consoleOutputs ++ [msg]})+      PutError msg -> modify @ConsoleState (\s -> s {consoleErrors = s.consoleErrors ++ [msg]})+      GetLine -> pure ""+      Confirm _prompt -> pure False+      IsInteractive -> pure False
+ src/Seihou/Effect/DhallEval.hs view
@@ -0,0 +1,16 @@+module Seihou.Effect.DhallEval+  ( DhallEval (..),+    evalModuleFile,+  )+where++import Seihou.Core.Types (Module, ModuleLoadError)+import Seihou.Prelude++data DhallEval :: Effect where+  EvalModuleFile :: FilePath -> DhallEval m (Either ModuleLoadError Module)++type instance DispatchOf DhallEval = Dynamic++evalModuleFile :: (DhallEval :> es) => FilePath -> Eff es (Either ModuleLoadError Module)+evalModuleFile path = send (EvalModuleFile path)
+ src/Seihou/Effect/DhallEvalInterp.hs view
@@ -0,0 +1,25 @@+module Seihou.Effect.DhallEvalInterp+  ( runDhallEval,+    runDhallEvalPure,+  )+where++import Data.Map.Strict qualified as Map+import Seihou.Core.Types (Module, ModuleLoadError (..))+import Seihou.Dhall.Eval (evalModuleFromFile)+import Seihou.Effect.DhallEval (DhallEval (..))+import Seihou.Prelude++-- | Real interpreter that evaluates Dhall files from disk.+runDhallEval :: (IOE :> es) => Eff (DhallEval : es) a -> Eff es a+runDhallEval = interpret $ \_ -> \case+  EvalModuleFile path -> liftIO (evalModuleFromFile path)++-- | Pure test interpreter that looks up modules from an in-memory map.+-- The map keys are file paths; if a path is not found, an error is raised.+runDhallEvalPure :: Map FilePath Module -> Eff (DhallEval : es) a -> Eff es a+runDhallEvalPure modules = interpret $ \_ -> \case+  EvalModuleFile path ->+    case Map.lookup path modules of+      Just m -> pure (Right m)+      Nothing -> error ("runDhallEvalPure: no module at path: " <> path)
+ src/Seihou/Effect/Filesystem.hs view
@@ -0,0 +1,75 @@+module Seihou.Effect.Filesystem+  ( Filesystem (..),+    readFileText,+    writeFileText,+    copyFile,+    listDirectory,+    createDirectoryIfMissing,+    doesFileExist,+    doesDirectoryExist,+    getCurrentDirectory,+    removeFile,+    removeDirectoryIfEmpty,+    renamePath,+    removeDirectoryRecursive,+  )+where++import Seihou.Prelude++data Filesystem :: Effect where+  ReadFileText :: FilePath -> Filesystem m Text+  WriteFileText :: FilePath -> Text -> Filesystem m ()+  CopyFile :: FilePath -> FilePath -> Filesystem m ()+  ListDirectory :: FilePath -> Filesystem m [FilePath]+  CreateDirectoryIfMissing :: Bool -> FilePath -> Filesystem m ()+  DoesFileExist :: FilePath -> Filesystem m Bool+  DoesDirectoryExist :: FilePath -> Filesystem m Bool+  GetCurrentDirectory :: Filesystem m FilePath+  RemoveFile :: FilePath -> Filesystem m ()+  RemoveDirectoryIfEmpty :: FilePath -> Filesystem m ()+  -- | Rename a file or directory atomically (within a filesystem).+  -- Backed by 'System.Directory.renamePath' in IO.+  RenamePath :: FilePath -> FilePath -> Filesystem m ()+  -- | Recursively delete a directory and all its contents. Backed by+  -- 'System.Directory.removeDirectoryRecursive' in IO. The pure+  -- interpreter drops every map entry under the prefix.+  RemoveDirectoryRecursive :: FilePath -> Filesystem m ()++type instance DispatchOf Filesystem = Dynamic++readFileText :: (Filesystem :> es) => FilePath -> Eff es Text+readFileText path = send (ReadFileText path)++writeFileText :: (Filesystem :> es) => FilePath -> Text -> Eff es ()+writeFileText path content = send (WriteFileText path content)++copyFile :: (Filesystem :> es) => FilePath -> FilePath -> Eff es ()+copyFile src dest = send (CopyFile src dest)++listDirectory :: (Filesystem :> es) => FilePath -> Eff es [FilePath]+listDirectory path = send (ListDirectory path)++createDirectoryIfMissing :: (Filesystem :> es) => Bool -> FilePath -> Eff es ()+createDirectoryIfMissing parents path = send (CreateDirectoryIfMissing parents path)++doesFileExist :: (Filesystem :> es) => FilePath -> Eff es Bool+doesFileExist path = send (DoesFileExist path)++doesDirectoryExist :: (Filesystem :> es) => FilePath -> Eff es Bool+doesDirectoryExist path = send (DoesDirectoryExist path)++getCurrentDirectory :: (Filesystem :> es) => Eff es FilePath+getCurrentDirectory = send GetCurrentDirectory++removeFile :: (Filesystem :> es) => FilePath -> Eff es ()+removeFile path = send (RemoveFile path)++removeDirectoryIfEmpty :: (Filesystem :> es) => FilePath -> Eff es ()+removeDirectoryIfEmpty path = send (RemoveDirectoryIfEmpty path)++renamePath :: (Filesystem :> es) => FilePath -> FilePath -> Eff es ()+renamePath src dest = send (RenamePath src dest)++removeDirectoryRecursive :: (Filesystem :> es) => FilePath -> Eff es ()+removeDirectoryRecursive path = send (RemoveDirectoryRecursive path)
+ src/Seihou/Effect/FilesystemInterp.hs view
@@ -0,0 +1,38 @@+module Seihou.Effect.FilesystemInterp+  ( runFilesystem,+  )+where++import Control.Monad (when)+import Data.Text.IO qualified as TIO+import Seihou.Effect.Filesystem (Filesystem (..))+import Seihou.Prelude+import System.Directory qualified as Dir++-- | Real IO interpreter for the Filesystem effect.+-- Delegates to System.Directory and Data.Text.IO.+runFilesystem :: (IOE :> es) => Eff (Filesystem : es) a -> Eff es a+runFilesystem = interpret $ \_ -> \case+  ReadFileText path -> liftIO (TIO.readFile path)+  WriteFileText path content -> liftIO (TIO.writeFile path content)+  CopyFile src dest -> liftIO (Dir.copyFile src dest)+  ListDirectory path -> liftIO (Dir.listDirectory path)+  CreateDirectoryIfMissing parents path ->+    liftIO (Dir.createDirectoryIfMissing parents path)+  DoesFileExist path -> liftIO (Dir.doesFileExist path)+  DoesDirectoryExist path -> liftIO (Dir.doesDirectoryExist path)+  GetCurrentDirectory -> liftIO Dir.getCurrentDirectory+  RemoveFile path -> liftIO (Dir.removeFile path)+  RemoveDirectoryIfEmpty path -> liftIO $ do+    -- Treat a missing directory as a no-op so this matches the pure+    -- interpreter's semantics. Without this guard, callers that walk+    -- a list of "maybe-now-empty" parents (e.g. cleanupEmptyDirs in+    -- Engine.Migrate / Engine.Remove) crash whenever a sibling+    -- operation — typically a user-authored 'rm -rf' RunCommand step+    -- in a migration chain — has already removed the directory.+    exists <- Dir.doesDirectoryExist path+    when exists $ do+      entries <- Dir.listDirectory path+      when (null entries) (Dir.removeDirectory path)+  RenamePath src dest -> liftIO (Dir.renamePath src dest)+  RemoveDirectoryRecursive path -> liftIO (Dir.removeDirectoryRecursive path)
+ src/Seihou/Effect/FilesystemPure.hs view
@@ -0,0 +1,128 @@+module Seihou.Effect.FilesystemPure+  ( runFilesystemPure,+    PureFS (..),+    emptyFS,+  )+where++import Data.Map.Strict qualified as Map+import Data.Set qualified as Set+import Effectful.State.Static.Local (State, get, modify, put, runState)+import Seihou.Effect.Filesystem (Filesystem (..))+import Seihou.Prelude++-- | In-memory filesystem state for testing.+data PureFS = PureFS+  { files :: Map FilePath Text,+    dirs :: Set FilePath+  }+  deriving stock (Eq, Show)++-- | An empty in-memory filesystem.+emptyFS :: PureFS+emptyFS = PureFS Map.empty Set.empty++-- | Pure in-memory interpreter for the Filesystem effect.+-- Useful for testing without touching the real filesystem.+runFilesystemPure :: PureFS -> Eff (Filesystem : es) a -> Eff es (a, PureFS)+runFilesystemPure initial = reinterpret (runState initial) handler+  where+    handler :: (State PureFS :> es') => EffectHandler Filesystem es'+    handler _ = \case+      ReadFileText path -> do+        fs <- get @PureFS+        case Map.lookup path fs.files of+          Just content -> pure content+          Nothing -> error ("runFilesystemPure: file not found: " <> path)+      WriteFileText path content -> do+        modify @PureFS (\fs -> fs {files = Map.insert path content fs.files})+      CopyFile src dest -> do+        fs <- get @PureFS+        case Map.lookup src fs.files of+          Just content ->+            put fs {files = Map.insert dest content fs.files}+          Nothing -> error ("runFilesystemPure: source file not found: " <> src)+      ListDirectory path -> do+        fs <- get @PureFS+        let prefix = if null path then "" else path <> "/"+            filesInDir =+              [ drop (length prefix) fp+              | fp <- Map.keys fs.files,+                isDirectChild prefix fp+              ]+            dirsInDir =+              [ drop (length prefix) d+              | d <- Set.toList fs.dirs,+                isDirectChild prefix d+              ]+        pure (filesInDir <> dirsInDir)+      CreateDirectoryIfMissing _parents path -> do+        modify @PureFS (\fs -> fs {dirs = Set.insert path fs.dirs})+      DoesFileExist path -> do+        fs <- get @PureFS+        pure (Map.member path fs.files)+      DoesDirectoryExist path -> do+        fs <- get @PureFS+        pure (Set.member path fs.dirs)+      GetCurrentDirectory -> pure "/pure-fs"+      RemoveFile path -> do+        modify @PureFS (\fs -> fs {files = Map.delete path fs.files})+      RemoveDirectoryIfEmpty path -> do+        fs <- get @PureFS+        let hasChildren =+              any (\fp -> (path <> "/") `isPrefixOfPath` fp) (Map.keys fs.files)+                || any (\d -> (path <> "/") `isPrefixOfPath` d) (Set.toList fs.dirs)+        if hasChildren+          then pure ()+          else modify @PureFS (\fs' -> fs' {dirs = Set.delete path fs'.dirs})+      RenamePath src dest -> do+        modify @PureFS (renameInPureFS src dest)+      RemoveDirectoryRecursive path -> do+        modify @PureFS (removeRecursivelyFromPureFS path)++-- | Check if a path is a direct child of a prefix directory.+isDirectChild :: String -> String -> Bool+isDirectChild "" fp = '/' `notElem` fp+isDirectChild prefix fp =+  prefix `isPrefixOfPath` fp+    && '/' `notElem` drop (length prefix) fp++isPrefixOfPath :: String -> String -> Bool+isPrefixOfPath [] _ = True+isPrefixOfPath _ [] = False+isPrefixOfPath (x : xs) (y : ys)+  | x == y = isPrefixOfPath xs ys+  | otherwise = False++-- | Rename @src@ to @dest@ in the pure filesystem. Handles two cases:+--+--   * A single file at exactly @src@ (rename the entry).+--   * A directory at @src@ (rewrite every key under @src/@ to @dest/@,+--     and rewrite the @dirs@ set similarly).+--+-- If @src@ does not exist as either a file or a directory prefix, this+-- is a no-op (mirrors the in-memory model; the IO interpreter would+-- raise an exception, which is expected behavior at the engine layer+-- when callers have already validated existence).+renameInPureFS :: FilePath -> FilePath -> PureFS -> PureFS+renameInPureFS src dest fs =+  let renamedFiles = Map.mapKeys (renameKey src dest) fs.files+      renamedDirs = Set.map (renameKey src dest) fs.dirs+   in fs {files = renamedFiles, dirs = renamedDirs}+  where+    renameKey s d k+      | k == s = d+      | (s <> "/") `isPrefixOfPath` k = d <> drop (length s) k+      | otherwise = k++-- | Recursively delete every entry under @path@ (and @path@ itself,+-- treated as a directory).+removeRecursivelyFromPureFS :: FilePath -> PureFS -> PureFS+removeRecursivelyFromPureFS path fs =+  let prefix = path <> "/"+      keepFile k = k /= path && not (prefix `isPrefixOfPath` k)+      keepDir d = d /= path && not (prefix `isPrefixOfPath` d)+   in fs+        { files = Map.filterWithKey (\k _ -> keepFile k) fs.files,+          dirs = Set.filter keepDir fs.dirs+        }
+ src/Seihou/Effect/Logger.hs view
@@ -0,0 +1,30 @@+module Seihou.Effect.Logger+  ( Logger (..),+    logDebug,+    logInfo,+    logWarn,+    logError,+  )+where++import Seihou.Prelude++data Logger :: Effect where+  LogDebug :: Text -> Logger m ()+  LogInfo :: Text -> Logger m ()+  LogWarn :: Text -> Logger m ()+  LogError :: Text -> Logger m ()++type instance DispatchOf Logger = Dynamic++logDebug :: (Logger :> es) => Text -> Eff es ()+logDebug msg = send (LogDebug msg)++logInfo :: (Logger :> es) => Text -> Eff es ()+logInfo msg = send (LogInfo msg)++logWarn :: (Logger :> es) => Text -> Eff es ()+logWarn msg = send (LogWarn msg)++logError :: (Logger :> es) => Text -> Eff es ()+logError msg = send (LogError msg)
+ src/Seihou/Effect/LoggerInterp.hs view
@@ -0,0 +1,38 @@+module Seihou.Effect.LoggerInterp+  ( runLoggerIO,+    shouldLog,+  )+where++import Control.Monad (when)+import Data.Text qualified as T+import Seihou.Core.Types (LogLevel (..))+import Seihou.Effect.Logger (Logger (..))+import Seihou.Prelude+import System.IO (hPutStrLn, stderr)++-- | IO interpreter for the Logger effect.+-- Messages are written to stderr, filtered by the given 'LogLevel'.+-- At 'LogQuiet', only errors are shown. At 'LogNormal', warnings and errors.+-- At 'LogVerbose', all messages including info and debug.+runLoggerIO :: (IOE :> es) => LogLevel -> Eff (Logger : es) a -> Eff es a+runLoggerIO level = interpret $ \_ -> \case+  LogDebug msg -> whenLevel LogVerbose $ emit "[debug] " msg+  LogInfo msg -> whenLevel LogVerbose $ emit "[info]  " msg+  LogWarn msg -> whenLevel LogNormal $ emit "[warn]  " msg+  LogError msg -> whenLevel LogQuiet $ emit "[error] " msg+  where+    whenLevel minLevel action =+      when (shouldLog level minLevel) action+    emit prefix msg =+      liftIO $ hPutStrLn stderr (T.unpack (prefix <> msg))++-- | Pure filtering predicate: does the configured level permit a message+-- that requires @minLevel@?+--+-- >>> shouldLog LogVerbose LogVerbose+-- True+-- >>> shouldLog LogNormal LogVerbose+-- False+shouldLog :: LogLevel -> LogLevel -> Bool+shouldLog configured minLevel = configured >= minLevel
+ src/Seihou/Effect/LoggerPure.hs view
@@ -0,0 +1,37 @@+module Seihou.Effect.LoggerPure+  ( runLoggerPure,+    LoggerState (..),+    emptyLoggerState,+  )+where++import Effectful.State.Static.Local (State, modify, runState)+import Seihou.Effect.Logger (Logger (..))+import Seihou.Prelude++-- | State capturing all log messages by severity.+-- Messages are appended in order within each field.+data LoggerState = LoggerState+  { logDebugMsgs :: [Text],+    logInfoMsgs :: [Text],+    logWarnMsgs :: [Text],+    logErrorMsgs :: [Text]+  }+  deriving stock (Eq, Show)++-- | Empty logger state with no captured messages.+emptyLoggerState :: LoggerState+emptyLoggerState = LoggerState [] [] [] []++-- | Pure interpreter for the Logger effect.+-- Captures all messages regardless of level, organized by severity.+-- Use this for testing code that emits log messages.+runLoggerPure :: Eff (Logger : es) a -> Eff es (a, LoggerState)+runLoggerPure = reinterpret (runState emptyLoggerState) handler+  where+    handler :: (State LoggerState :> es') => EffectHandler Logger es'+    handler _ = \case+      LogDebug msg -> modify @LoggerState (\s -> s {logDebugMsgs = s.logDebugMsgs ++ [msg]})+      LogInfo msg -> modify @LoggerState (\s -> s {logInfoMsgs = s.logInfoMsgs ++ [msg]})+      LogWarn msg -> modify @LoggerState (\s -> s {logWarnMsgs = s.logWarnMsgs ++ [msg]})+      LogError msg -> modify @LoggerState (\s -> s {logErrorMsgs = s.logErrorMsgs ++ [msg]})
+ src/Seihou/Effect/ManifestStore.hs view
@@ -0,0 +1,21 @@+module Seihou.Effect.ManifestStore+  ( ManifestStore (..),+    readManifest,+    writeManifest,+  )+where++import Seihou.Core.Types (Manifest)+import Seihou.Prelude++data ManifestStore :: Effect where+  ReadManifest :: ManifestStore m (Either Text (Maybe Manifest))+  WriteManifest :: Manifest -> ManifestStore m ()++type instance DispatchOf ManifestStore = Dynamic++readManifest :: (ManifestStore :> es) => Eff es (Either Text (Maybe Manifest))+readManifest = send ReadManifest++writeManifest :: (ManifestStore :> es) => Manifest -> Eff es ()+writeManifest m = send (WriteManifest m)
+ src/Seihou/Effect/ManifestStoreInterp.hs view
@@ -0,0 +1,44 @@+module Seihou.Effect.ManifestStoreInterp+  ( runManifestStore,+  )+where++import Control.Monad (unless)+import Data.ByteString.Lazy qualified as LBS+import Data.Text qualified as T+import Data.Text.Encoding qualified as TE+import Seihou.Effect.Filesystem (Filesystem, createDirectoryIfMissing, doesFileExist, readFileText, renamePath, writeFileText)+import Seihou.Effect.ManifestStore (ManifestStore (..))+import Seihou.Manifest.Types (manifestFromJSON, manifestToJSON)+import Seihou.Prelude+import System.FilePath (takeDirectory)++-- | Real interpreter for the ManifestStore effect.+-- Reads and writes manifest JSON via the Filesystem effect.+-- Write is atomic within one filesystem: writes to a temp path in the+-- manifest directory, then renames that complete file over the final path.+runManifestStore ::+  (Filesystem :> es) =>+  FilePath ->+  Eff (ManifestStore : es) a ->+  Eff es a+runManifestStore manifestPath = interpret $ \_ -> \case+  ReadManifest -> do+    exists <- doesFileExist manifestPath+    if not exists+      then pure (Right Nothing)+      else do+        content <- readFileText manifestPath+        let bs = LBS.fromStrict (TE.encodeUtf8 content)+        case manifestFromJSON bs of+          Left err -> pure (Left (T.pack err))+          Right manifest -> pure (Right (Just manifest))+  WriteManifest manifest -> do+    let bs = manifestToJSON manifest+        content = TE.decodeUtf8 (LBS.toStrict bs)+        tmpPath = manifestPath <> ".tmp"+        parentDir = takeDirectory manifestPath+    unless (parentDir == "." || null parentDir) $+      createDirectoryIfMissing True parentDir+    writeFileText tmpPath content+    renamePath tmpPath manifestPath
+ src/Seihou/Effect/ManifestStorePure.hs view
@@ -0,0 +1,22 @@+module Seihou.Effect.ManifestStorePure+  ( runManifestStorePure,+  )+where++import Effectful.State.Static.Local (State, get, put, runState)+import Seihou.Core.Types (Manifest)+import Seihou.Effect.ManifestStore (ManifestStore (..))+import Seihou.Prelude++-- | Pure in-memory interpreter for the ManifestStore effect.+-- Stores the manifest in effectful State.+runManifestStorePure ::+  Maybe Manifest ->+  Eff (ManifestStore : es) a ->+  Eff es (a, Maybe Manifest)+runManifestStorePure initial = reinterpret (runState initial) handler+  where+    handler :: (State (Maybe Manifest) :> es') => EffectHandler ManifestStore es'+    handler _ = \case+      ReadManifest -> Right <$> get @(Maybe Manifest)+      WriteManifest manifest -> put (Just manifest)
+ src/Seihou/Effect/Process.hs view
@@ -0,0 +1,16 @@+module Seihou.Effect.Process+  ( Process (..),+    runProcess,+  )+where++import Seihou.Prelude+import System.Exit (ExitCode)++data Process :: Effect where+  RunProcess :: Text -> [Text] -> Maybe FilePath -> Process m (ExitCode, Text, Text)++type instance DispatchOf Process = Dynamic++runProcess :: (Process :> es) => Text -> [Text] -> Maybe FilePath -> Eff es (ExitCode, Text, Text)+runProcess cmd args workDir = send (RunProcess cmd args workDir)
+ src/Seihou/Effect/ProcessInterp.hs view
@@ -0,0 +1,20 @@+module Seihou.Effect.ProcessInterp+  ( runProcessIO,+  )+where++import Data.Text qualified as T+import Seihou.Effect.Process (Process (..))+import Seihou.Prelude+import System.Exit (ExitCode)+import System.Process (CreateProcess (..), proc, readCreateProcessWithExitCode)++runProcessIO :: (IOE :> es) => Eff (Process : es) a -> Eff es a+runProcessIO = interpret $ \_ -> \case+  RunProcess cmd args workDir -> liftIO $ do+    let cp =+          (proc (T.unpack cmd) (map T.unpack args))+            { cwd = workDir+            }+    (exitCode, stdout, stderr) <- readCreateProcessWithExitCode cp ""+    pure (exitCode, T.pack stdout, T.pack stderr)
+ src/Seihou/Effect/ProcessPure.hs view
@@ -0,0 +1,29 @@+module Seihou.Effect.ProcessPure+  ( runProcessPure,+    ProcessMock (..),+  )+where++import Seihou.Effect.Process (Process (..))+import Seihou.Prelude+import System.Exit (ExitCode (..))++data ProcessMock = ProcessMock+  { mockCommand :: Text,+    mockArgs :: [Text],+    mockResult :: (ExitCode, Text, Text)+  }+  deriving stock (Eq, Show)++runProcessPure :: [ProcessMock] -> Eff (Process : es) a -> Eff es a+runProcessPure mocks = interpret $ \_ -> \case+  RunProcess cmd args _workDir ->+    case findMock cmd args mocks of+      Just result -> pure result+      Nothing -> pure (ExitFailure 127, "", "command not found: " <> cmd)++findMock :: Text -> [Text] -> [ProcessMock] -> Maybe (ExitCode, Text, Text)+findMock _ _ [] = Nothing+findMock cmd args (m : ms)+  | m.mockCommand == cmd && m.mockArgs == args = Just m.mockResult+  | otherwise = findMock cmd args ms
+ src/Seihou/Engine/Conflict.hs view
@@ -0,0 +1,86 @@+module Seihou.Engine.Conflict+  ( resolveConflicts,+    resolveConflictsInteractive,+  )+where++import Data.Text qualified as T+import Seihou.Core.Types (ConflictFile (..), ConflictResolution (..))+import Seihou.Effect.Console (Console, getLine, isInteractive, putText)+import Seihou.Prelude+import Prelude hiding (getLine)++-- | Resolve a list of conflicts, returning per-file resolutions.+--+-- Returns 'Just' with the list of resolutions when all conflicts are handled,+-- or 'Nothing' when the run should abort (non-interactive without force, or+-- user chose Abort).+--+-- Behavior:+--   * Empty conflict list → @Just []@.+--   * @force = True@ → all conflicts resolved as 'AcceptNew'.+--   * Non-interactive terminal → 'Nothing' (caller should print errors and exit).+--   * Interactive terminal → prompts user for each file via 'resolveConflictsInteractive'.+resolveConflicts ::+  (Console :> es) =>+  Bool ->+  [ConflictFile] ->+  Eff es (Maybe [(ConflictFile, ConflictResolution)])+resolveConflicts _ [] = pure (Just [])+resolveConflicts force conflicts+  | force = pure (Just (map (\c -> (c, AcceptNew)) conflicts))+  | otherwise = do+      interactive <- isInteractive+      if interactive+        then resolveConflictsInteractive conflicts+        else pure Nothing++-- | Interactively prompt for each conflicted file.+--+-- For each conflict, displays the file path and offers four choices:+-- accept (overwrite), keep (preserve disk copy), skip (leave untouched),+-- or abort (stop the entire run).+--+-- Returns 'Nothing' if the user chooses Abort on any file.+resolveConflictsInteractive ::+  (Console :> es) =>+  [ConflictFile] ->+  Eff es (Maybe [(ConflictFile, ConflictResolution)])+resolveConflictsInteractive = go []+  where+    go acc [] = pure (Just (reverse acc))+    go acc (c : cs) = do+      resolution <- promptConflict c+      case resolution of+        Abort -> pure Nothing+        _ -> go ((c, resolution) : acc) cs++-- | Prompt the user for a single conflict, re-prompting on invalid input.+promptConflict ::+  (Console :> es) =>+  ConflictFile ->+  Eff es ConflictResolution+promptConflict c = do+  putText $ "Conflict: " <> T.pack c.path <> " (modified since last generation)"+  promptChoice+  where+    promptChoice = do+      putText "  [a]ccept new  [k]eep current  [s]kip  [A]bort all"+      input <- getLine+      case parseChoice (T.strip input) of+        Just res -> pure res+        Nothing -> do+          putText "Invalid choice, try again."+          promptChoice++-- | Parse user input into a ConflictResolution.+parseChoice :: T.Text -> Maybe ConflictResolution+parseChoice "a" = Just AcceptNew+parseChoice "accept" = Just AcceptNew+parseChoice "k" = Just KeepCurrent+parseChoice "keep" = Just KeepCurrent+parseChoice "s" = Just Skip+parseChoice "skip" = Just Skip+parseChoice "A" = Just Abort+parseChoice "abort" = Just Abort+parseChoice _ = Nothing
+ src/Seihou/Engine/DhallJSON.hs view
@@ -0,0 +1,46 @@+module Seihou.Engine.DhallJSON+  ( dhallExprToJSON,+  )+where++import Data.Aeson qualified as Aeson+import Data.Aeson.Key qualified as Key+import Data.Foldable (toList)+import Data.Void (Void)+import Dhall.Core qualified as Dhall+import Dhall.Map qualified as DhallMap+import Dhall.Src (Src)+import Seihou.Prelude++-- | Convert a normalized Dhall expression to an aeson Value.+-- Supports records, text, naturals, integers, doubles, bools, lists, and optionals.+-- Returns Left with an error message for unsupported expression types.+dhallExprToJSON :: Dhall.Expr Src Void -> Either Text Aeson.Value+dhallExprToJSON = go+  where+    go (Dhall.RecordLit fields) = do+      pairs <- mapM convertField (DhallMap.toList fields)+      pure (Aeson.object pairs)+      where+        convertField (k, rf) = (Key.fromText k,) <$> go (Dhall.recordFieldValue rf)+    go (Dhall.TextLit (Dhall.Chunks [] t)) =+      pure (Aeson.String t)+    go (Dhall.NaturalLit n) =+      pure (Aeson.toJSON n)+    go (Dhall.IntegerLit n) =+      pure (Aeson.toJSON n)+    go (Dhall.DoubleLit (Dhall.DhallDouble d)) =+      pure (Aeson.toJSON d)+    go (Dhall.BoolLit b) =+      pure (Aeson.Bool b)+    go (Dhall.ListLit _ xs) = do+      items <- mapM go (toList xs)+      pure (Aeson.toJSON items)+    go (Dhall.Some e) =+      go e+    go (Dhall.App Dhall.None _) =+      pure Aeson.Null+    go (Dhall.Note _ e) =+      go e+    go expr =+      Left ("Cannot convert Dhall expression to JSON: " <> Dhall.pretty expr)
+ src/Seihou/Engine/Diff.hs view
@@ -0,0 +1,174 @@+module Seihou.Engine.Diff+  ( computeDiff,+    planToFileMap,+  )+where++import Data.Map.Strict qualified as Map+import Data.Set (Set)+import Data.Set qualified as Set+import Seihou.Core.Types+import Seihou.Effect.Filesystem (Filesystem, doesFileExist, readFileText)+import Seihou.Manifest.Hash (hashContent)+import Seihou.Prelude++-- | Extract a map of (path, content) from planned operations.+-- Only WriteFileOp and CopyFileOp produce file entries; directories and+-- commands are ignored.+planToFileMap :: [Operation] -> Map FilePath Text+planToFileMap = Map.fromList . concatMap extract+  where+    extract (WriteFileOp dest content _) = [(dest, content)]+    extract (PatchFileOp dest content _ _ _) = [(dest, content)]+    extract _ = []++-- | Compute a three-state diff: manifest vs plan vs disk.+-- Classifies each file into one of: New, Modified, Unchanged, Conflict, Orphaned.+-- Patch operations (append-section, append-file, prepend-file) are never+-- classified as conflicts because they are designed to merge with existing files.+--+-- The @activeModules@ parameter scopes orphan detection: only manifest files+-- owned by a module in this set can be classified as Orphaned. Files from+-- other modules are invisible to the diff, preserving them across independent+-- module runs.+computeDiff ::+  (Filesystem :> es) =>+  Manifest ->+  Set ModuleName ->+  [(FilePath, Text, ModuleName, Maybe PatchOp)] ->+  Eff es DiffResult+computeDiff manifest activeModules planned = do+  let manifestFiles' = manifest.files+      activeManifestFiles =+        Map.filter (\r -> r.moduleName `Set.member` activeModules) manifestFiles'+      planMap = Map.fromList [(p, (content, modName, patchOp)) | (p, content, modName, patchOp) <- planned]+      allPaths =+        Set.toList $+          Set.union+            (Map.keysSet activeManifestFiles)+            (Map.keysSet planMap)++  results <- mapM (classifyFile activeManifestFiles planMap) allPaths++  let newFiles = [f | ClassNew f <- results]+      modifiedFiles = [f | ClassModified f <- results]+      unchangedFiles = [f | ClassUnchanged f <- results]+      conflictFiles = [f | ClassConflict f <- results]+      orphanedFiles = [f | ClassOrphaned f <- results]++  pure+    DiffResult+      { new = newFiles,+        modified = modifiedFiles,+        unchanged = unchangedFiles,+        conflicts = conflictFiles,+        orphaned = orphanedFiles+      }++data Classification+  = ClassNew PlannedFile+  | ClassModified ModifiedFile+  | ClassUnchanged FilePath+  | ClassConflict ConflictFile+  | ClassOrphaned OrphanedFile++classifyFile ::+  (Filesystem :> es) =>+  Map FilePath FileRecord ->+  Map FilePath (Text, ModuleName, Maybe PatchOp) ->+  FilePath ->+  Eff es Classification+classifyFile manifestFiles' planMap path = do+  let inManifest = Map.lookup path manifestFiles'+      inPlan = Map.lookup path planMap+      isPatch = case inPlan of+        Just (_, _, Just _) -> True+        _ -> False+  onDisk <- doesFileExist path++  case (inManifest, inPlan, onDisk) of+    -- In plan, not in manifest, not on disk → New+    (Nothing, Just (content, modName, _), False) ->+      pure $ ClassNew (PlannedFile {path = path, moduleName = modName, content = content})+    -- In plan, not in manifest, on disk → Patch ops merge with existing files (New);+    -- non-patch ops conflict (file exists but wasn't generated by us)+    (Nothing, Just (content, modName, _), True)+      | isPatch ->+          pure $ ClassNew (PlannedFile {path = path, moduleName = modName, content = content})+      | otherwise -> do+          diskContent <- readFileText path+          let diskHash = hashContent diskContent+          pure $+            ClassConflict+              ( ConflictFile+                  { path = path,+                    moduleName = modName,+                    manifestHash = SHA256 "",+                    diskHash = diskHash,+                    planContent = content+                  }+              )+    -- In manifest + plan + disk+    (Just record, Just (content, modName, _), True) -> do+      diskContent <- readFileText path+      let diskHash = hashContent diskContent+          manifestHash = record.hash+          planHash = hashContent content+      if diskHash /= manifestHash+        then+          -- Patch ops always merge, even if the user modified the file+          if isPatch+            then+              pure $+                ClassModified+                  ( ModifiedFile+                      { path = path,+                        moduleName = modName,+                        oldHash = manifestHash,+                        newContent = content+                      }+                  )+            else -- User modified the file → Conflict+              pure $+                ClassConflict+                  ( ConflictFile+                      { path = path,+                        moduleName = modName,+                        manifestHash = manifestHash,+                        diskHash = diskHash,+                        planContent = content+                      }+                  )+        else+          if planHash == manifestHash+            then pure $ ClassUnchanged path+            else+              pure $+                ClassModified+                  ( ModifiedFile+                      { path = path,+                        moduleName = modName,+                        oldHash = manifestHash,+                        newContent = content+                      }+                  )+    -- In manifest + plan, not on disk → treat as Modified (file was deleted by user, re-create)+    (Just record, Just (content, modName, _), False) ->+      pure $+        ClassModified+          ( ModifiedFile+              { path = path,+                moduleName = modName,+                oldHash = record.hash,+                newContent = content+              }+          )+    -- In manifest, not in plan, on disk → Orphaned+    (Just record, Nothing, True) ->+      pure $ ClassOrphaned (OrphanedFile {path = path, moduleName = record.moduleName})+    -- In manifest, not in plan, not on disk → Orphaned (already deleted)+    (Just record, Nothing, False) ->+      pure $ ClassOrphaned (OrphanedFile {path = path, moduleName = record.moduleName})+    -- Not in manifest, not in plan → shouldn't happen (we only iterate known paths)+    (Nothing, Nothing, _) ->+      pure $ ClassUnchanged path -- unreachable in practice
+ src/Seihou/Engine/Execute.hs view
@@ -0,0 +1,114 @@+module Seihou.Engine.Execute+  ( executePlan,+    dryRunPlan,+  )+where++import Data.Map.Strict qualified as Map+import Data.Text qualified as T+import Data.Time (UTCTime)+import Seihou.Core.Types+import Seihou.Effect.Filesystem+import Seihou.Engine.Section (applyTextPatch)+import Seihou.Manifest.Hash (hashContent)+import Seihou.Prelude++-- | Execute a list of operations against the filesystem.+-- Returns a map of file paths to FileRecord entries for the manifest.+--+-- The @ownerMap@ attributes each generated file to the module instance+-- (by its qualified name) that produced it. Paths not present in the+-- map fall back to the default @moduleName'@ — this preserves single-+-- module call-sites and test usage that do not build an ownership map.+executePlan ::+  (Filesystem :> es) =>+  FilePath ->+  [Operation] ->+  Map FilePath ModuleName ->+  ModuleName ->+  UTCTime ->+  Eff es (Map FilePath FileRecord)+executePlan targetDir ops ownerMap moduleName' now = do+  let ownerFor dest = Map.findWithDefault moduleName' dest ownerMap+  records <- mapM (executeOp targetDir ownerFor now) ops+  pure (Map.fromList [(k, v) | Just (k, v) <- records])++-- | Execute a single operation and return a FileRecord if a file was written.+executeOp ::+  (Filesystem :> es) =>+  FilePath ->+  (FilePath -> ModuleName) ->+  UTCTime ->+  Operation ->+  Eff es (Maybe (FilePath, FileRecord))+executeOp targetDir ownerFor now op = case op of+  WriteFileOp dest content strat -> do+    let fullPath = targetDir </> dest+    writeFileText fullPath content+    let record =+          FileRecord+            { hash = hashContent content,+              moduleName = ownerFor dest,+              strategy = strat,+              generatedAt = now+            }+    pure (Just (dest, record))+  CreateDirOp path -> do+    let fullPath = targetDir </> path+    createDirectoryIfMissing True fullPath+    pure Nothing+  CopyFileOp src dest -> do+    let fullDest = targetDir </> dest+    content <- readFileText src+    writeFileText fullDest content+    let record =+          FileRecord+            { hash = hashContent content,+              moduleName = ownerFor dest,+              strategy = Copy,+              generatedAt = now+            }+    pure (Just (dest, record))+  RunCommandOp _ _ -> do+    -- Command execution is deferred to the CLI layer.+    pure Nothing+  PatchFileOp dest newContent patchOp' strat modName -> do+    let fullPath = targetDir </> dest+    -- Read existing content if the file exists, otherwise start empty+    exists <- doesFileExist fullPath+    existing <-+      if exists+        then readFileText fullPath+        else pure ""+    -- Apply the patch with "#" as default comment prefix+    case applyTextPatch patchOp' modName "#" existing newContent of+      Left err -> error ("Patch failed: " <> T.unpack err)+      Right merged -> do+        writeFileText fullPath merged+        let record =+              FileRecord+                { hash = hashContent merged,+                  moduleName = ownerFor dest,+                  strategy = strat,+                  generatedAt = now+                }+        pure (Just (dest, record))++-- | Format a human-readable description of the plan without executing anything.+dryRunPlan :: [Operation] -> Text+dryRunPlan ops =+  if null ops+    then "No operations to perform."+    else T.unlines (map formatOp ops)+  where+    formatOp :: Operation -> Text+    formatOp (WriteFileOp dest _ _) = "  write " <> T.pack dest+    formatOp (CreateDirOp path) = "  mkdir " <> T.pack path+    formatOp (CopyFileOp src dest) = "  copy  " <> T.pack src <> " -> " <> T.pack dest+    formatOp (RunCommandOp cmd _) = "  run   " <> cmd+    formatOp (PatchFileOp dest _ patchOp' _ modName) =+      "  patch " <> T.pack dest <> " (" <> formatPatchOp patchOp' <> " from " <> modName.unModuleName <> ")"+    formatPatchOp AppendFile = "append-file"+    formatPatchOp PrependFile = "prepend-file"+    formatPatchOp AppendSection = "append-section"+    formatPatchOp AppendLineIfAbsent = "append-line-if-absent"
+ src/Seihou/Engine/Migrate.hs view
@@ -0,0 +1,367 @@+module Seihou.Engine.Migrate+  ( -- * Engine types+    MigrationFileStatus (..),+    MigrationOpInstance (..),+    ExecutedMigrationPlan (..),+    MigrationExecError (..),++    -- * Engine entry points+    classifyMigration,+    executeMigration,+  )+where++import Data.List (nub, sortBy)+import Data.Map.Strict qualified as Map+import Data.Ord (Down (..))+import Data.Text qualified as T+import Data.Time (UTCTime)+import GHC.Generics (Generic)+import Seihou.Core.Migration+  ( Migration (..),+    MigrationOp (..),+    MigrationPlan (..),+  )+import Seihou.Core.Path (validateProjectRelativePath)+import Seihou.Core.Types+  ( AppliedModule (..),+    FileRecord (..),+    Manifest (..),+    ModuleName (..),+  )+import Seihou.Core.Version (renderVersion)+import Seihou.Effect.Filesystem+  ( Filesystem,+    createDirectoryIfMissing,+    doesFileExist,+    readFileText,+    removeDirectoryIfEmpty,+    removeDirectoryRecursive,+    removeFile,+    renamePath,+  )+import Seihou.Effect.Process (Process, runProcess)+import Seihou.Manifest.Hash (hashContent)+import Seihou.Prelude+import System.Exit (ExitCode (..))+import System.FilePath (takeDirectory)++-- ----------------------------------------------------------------------------+-- Types+-- ----------------------------------------------------------------------------++-- | Per-file safety classification, mirroring 'Seihou.Engine.Remove'.+--+--   * 'MFSafe'     — disk hash matches the manifest's recorded hash; safe+--     to move or delete without losing user edits.+--   * 'MFConflict' — disk hash differs from the manifest's recorded hash;+--     the user has modified the file since generation and the engine+--     refuses to clobber it unless the caller passes @force = True@.+--   * 'MFGone'     — file is absent on disk. The op is a no-op (target+--     of a delete already gone, source of a move already gone).+data MigrationFileStatus = MFSafe | MFConflict | MFGone+  deriving stock (Eq, Show, Generic)++-- | A 'MigrationOp' lifted to a concrete, classified instance ready to+-- execute or render. Move/delete *file* ops carry the file's status (so+-- the CLI can render conflicts up front); directory and command ops do+-- not — directories imply many files, and a command's effect is opaque.+data MigrationOpInstance+  = MoveFileInst FilePath FilePath MigrationFileStatus+  | MoveDirInst FilePath FilePath+  | DeleteFileInst FilePath MigrationFileStatus+  | DeleteDirInst FilePath+  | RunCommandInst Text (Maybe FilePath)+  deriving stock (Eq, Show, Generic)++-- | The complete plan that 'classifyMigration' returns: the planner's+-- 'MigrationPlan' it was built from, and the linearized list of+-- concrete op instances in execution order.+data ExecutedMigrationPlan = ExecutedMigrationPlan+  { planModule :: ModuleName,+    planSource :: MigrationPlan,+    planOps :: [MigrationOpInstance]+  }+  deriving stock (Eq, Show, Generic)++-- | Reasons the engine refuses to execute. 'MigrationConflict' carries+-- every disk path whose hash diverged from the manifest, so the CLI can+-- list them and tell the user what to inspect.+data MigrationExecError+  = MigrationConflict [FilePath]+  | MigrationCommandFailed Text Int+  | MigrationUnsafePath Text FilePath Text+  deriving stock (Eq, Show, Generic)++-- ----------------------------------------------------------------------------+-- classifyMigration+-- ----------------------------------------------------------------------------++-- | Walk a 'MigrationPlan' and produce a fully classified+-- 'ExecutedMigrationPlan'. The classification reads files from the+-- filesystem (for hash comparisons against the manifest) but does not+-- modify anything.+classifyMigration ::+  (Filesystem :> es) =>+  Manifest ->+  MigrationPlan ->+  Eff es (Either MigrationExecError ExecutedMigrationPlan)+classifyMigration manifest plan = do+  opsResult <- traverse (classifyOp manifest) (concatMap (.ops) plan.planSteps)+  pure $ do+    ops <- sequence opsResult+    Right+      ExecutedMigrationPlan+        { planModule = ModuleName plan.planModule,+          planSource = plan,+          planOps = ops+        }++-- | Classify a single 'MigrationOp' against the manifest and disk.+classifyOp ::+  (Filesystem :> es) =>+  Manifest ->+  MigrationOp ->+  Eff es (Either MigrationExecError MigrationOpInstance)+classifyOp manifest op = case op of+  MoveFile {src, dest} ->+    case (validateMigrationPath "move-file source" src, validateMigrationPath "move-file destination" dest) of+      (Left err, _) -> pure (Left err)+      (_, Left err) -> pure (Left err)+      (Right safeSrc, Right safeDest) -> do+        status <- classifyFile manifest safeSrc+        pure (Right (MoveFileInst safeSrc safeDest status))+  MoveDir {src, dest} ->+    pure $+      case (validateMigrationPath "move-dir source" src, validateMigrationPath "move-dir destination" dest) of+        (Left err, _) -> Left err+        (_, Left err) -> Left err+        (Right safeSrc, Right safeDest) -> Right (MoveDirInst safeSrc safeDest)+  DeleteFile {path} ->+    case validateMigrationPath "delete-file path" path of+      Left err -> pure (Left err)+      Right safePath -> do+        status <- classifyFile manifest safePath+        pure (Right (DeleteFileInst safePath status))+  DeleteDir {path} ->+    pure $+      case validateMigrationPath "delete-dir path" path of+        Left err -> Left err+        Right safePath -> Right (DeleteDirInst safePath)+  RunCommand {run, workDir} ->+    pure $+      case traverse (validateMigrationPath "run-command workDir") workDir of+        Left err -> Left err+        Right safeWorkDir -> Right (RunCommandInst run safeWorkDir)++validateMigrationPath :: Text -> FilePath -> Either MigrationExecError FilePath+validateMigrationPath label path =+  case validateProjectRelativePath (T.pack path) of+    Left reason -> Left (MigrationUnsafePath label path reason)+    Right safePath -> Right safePath++-- | Compare the disk copy of a file to the manifest's recorded hash.+-- Returns 'MFGone' if the file is missing, 'MFSafe' if the manifest has+-- no record (the migration is targeting a file the engine isn't tracking+-- — treat as safe), 'MFSafe' if hashes match, 'MFConflict' otherwise.+classifyFile ::+  (Filesystem :> es) =>+  Manifest ->+  FilePath ->+  Eff es MigrationFileStatus+classifyFile manifest path = do+  exists <- doesFileExist path+  if not exists+    then pure MFGone+    else case Map.lookup path (manifest.files :: Map FilePath FileRecord) of+      Nothing -> pure MFSafe+      Just rec -> do+        content <- readFileText path+        let diskHash = hashContent content+        if diskHash == rec.hash+          then pure MFSafe+          else pure MFConflict++-- ----------------------------------------------------------------------------+-- executeMigration+-- ----------------------------------------------------------------------------++-- | Execute a previously classified plan. On a conflict that isn't+-- forced, returns 'Left (MigrationConflict ...)' without touching disk.+-- Otherwise runs every op in declaration order, rewrites the manifest's+-- @files@ map to reflect new paths, bumps @genAt@ to the supplied+-- timestamp, and updates the named 'AppliedModule''s @moduleVersion@ to+-- @planTo@ (the user's supplied target). When the source plan has an+-- empty 'planSteps' list, no file ops run but the manifest still+-- advances to @planTo@ — this is the "pure version bump" path.+executeMigration ::+  (Filesystem :> es, Process :> es) =>+  -- | If 'True', proceed even when files are 'MFConflict'. Mirrors the+  -- @--force@ flag on @seihou remove@.+  Bool ->+  ExecutedMigrationPlan ->+  Manifest ->+  -- | New @genAt@ timestamp to stamp on the rewritten manifest.+  UTCTime ->+  Eff es (Either MigrationExecError Manifest)+executeMigration force plan manifest now = do+  let conflicts =+        [ p+        | inst <- plan.planOps,+          (p, MFConflict) <- toFileStatus inst+        ]+  if not force && not (null conflicts)+    then pure (Left (MigrationConflict conflicts))+    else do+      result <- runOps plan.planOps manifest []+      case result of+        Left err -> pure (Left err)+        Right (man', removedDirs) -> do+          cleanupEmptyDirs removedDirs+          let bumped =+                man'+                  { genAt = now,+                    modules = map (bumpVersion plan.planModule plan.planSource) man'.modules+                  }+          pure (Right bumped)++-- | Pull (path, status) pairs out of an op for conflict detection. Only+-- file-targeted ops (MoveFile, DeleteFile) contribute; directory ops are+-- not classified per-file at this layer.+toFileStatus :: MigrationOpInstance -> [(FilePath, MigrationFileStatus)]+toFileStatus (MoveFileInst p _ s) = [(p, s)]+toFileStatus (DeleteFileInst p s) = [(p, s)]+toFileStatus _ = []++-- | Apply each op in order. Returns the updated manifest and the list+-- of paths whose parent directories may now be empty (so the caller can+-- prune them, mirroring 'Seihou.Engine.Remove').+runOps ::+  (Filesystem :> es, Process :> es) =>+  [MigrationOpInstance] ->+  Manifest ->+  -- | Accumulated removed paths (reverse order; reversed by caller as needed)+  [FilePath] ->+  Eff es (Either MigrationExecError (Manifest, [FilePath]))+runOps [] manifest acc = pure (Right (manifest, acc))+runOps (op : rest) manifest acc = case op of+  -- For move/delete, re-check disk existence at execute time. The+  -- classified status is computed before any chain ops run, so a+  -- previous step in the chain may have created or removed files+  -- since then. The classified status is still authoritative for the+  -- up-front conflict check (we never silently overwrite a+  -- user-edited file without --force), but the disk action itself+  -- must be defensive.+  MoveFileInst src dest _status -> do+    exists <- doesFileExist src+    if exists+      then do+        ensureParentDir dest+        renamePath src dest+        runOps rest (renameInManifest src dest manifest) (src : acc)+      else runOps rest (renameInManifest src dest manifest) acc+  MoveDirInst src dest -> do+    ensureParentDir dest+    renamePath src dest+    runOps rest (renameDirInManifest src dest manifest) (src : acc)+  DeleteFileInst p _status -> do+    exists <- doesFileExist p+    if exists+      then do+        removeFile p+        runOps rest (dropFromManifest p manifest) (p : acc)+      else runOps rest (dropFromManifest p manifest) acc+  DeleteDirInst p -> do+    removeDirectoryRecursive p+    runOps rest (dropDirFromManifest p manifest) (p : acc)+  RunCommandInst run mWorkDir -> do+    (code, _stdout, stderr) <- runProcess "/bin/sh" ["-c", run] mWorkDir+    case code of+      ExitSuccess -> runOps rest manifest acc+      ExitFailure n ->+        let msg = if T.null stderr then run else stderr+         in pure (Left (MigrationCommandFailed msg n))++-- ----------------------------------------------------------------------------+-- Manifest rewrites+-- ----------------------------------------------------------------------------++-- | Rewrite a single key from @src@ to @dest@ in the manifest's @files@+-- map. If the key isn't present, the manifest is returned unchanged.+renameInManifest :: FilePath -> FilePath -> Manifest -> Manifest+renameInManifest src dest manifest =+  case Map.lookup src manifest.files of+    Nothing -> manifest+    Just rec ->+      manifest+        { files = Map.insert dest rec (Map.delete src manifest.files)+        }++-- | Rewrite every @files@ key whose path is @src@ or under @src/@ to+-- replace the prefix with @dest@.+renameDirInManifest :: FilePath -> FilePath -> Manifest -> Manifest+renameDirInManifest src dest manifest =+  let prefix = src <> "/"+      rewriteKey k+        | k == src = dest+        | prefix `isPrefixOfPath` k = dest <> "/" <> drop (length prefix) k+        | otherwise = k+   in manifest {files = Map.mapKeys rewriteKey manifest.files}++-- | Drop a single file entry from the manifest.+dropFromManifest :: FilePath -> Manifest -> Manifest+dropFromManifest p manifest =+  manifest {files = Map.delete p manifest.files}++-- | Drop every file entry whose path is @path@ or under @path/@.+dropDirFromManifest :: FilePath -> Manifest -> Manifest+dropDirFromManifest path manifest =+  let prefix = path <> "/"+      keep k = k /= path && not (prefix `isPrefixOfPath` k)+   in manifest {files = Map.filterWithKey (\k _ -> keep k) manifest.files}++-- | Update the named applied module's @moduleVersion@ to the plan's+-- target. Other applied modules are untouched.+bumpVersion :: ModuleName -> MigrationPlan -> AppliedModule -> AppliedModule+bumpVersion modName plan am+  | am.name == modName =+      am {moduleVersion = Just (renderVersion plan.planTo)}+  | otherwise = am++-- ----------------------------------------------------------------------------+-- Helpers (shared with Engine.Remove patterns)+-- ----------------------------------------------------------------------------++-- | Try to remove now-empty parent directories of the given paths.+cleanupEmptyDirs :: (Filesystem :> es) => [FilePath] -> Eff es ()+cleanupEmptyDirs paths = do+  let parentDirs = nub $ concatMap allParents paths+      sorted = sortBy (\a b -> compare (Down (length a)) (Down (length b))) parentDirs+  mapM_ removeDirectoryIfEmpty sorted++allParents :: FilePath -> [FilePath]+allParents p = go (takeDirectory p)+  where+    go "." = []+    go "" = []+    go "/" = []+    go d = d : go (takeDirectory d)++-- | Ensure the parent directory of a destination path exists. Used+-- before 'renamePath' so callers don't have to author moves that+-- happen to land where the engine has already created an intermediate+-- directory. Skips the call when the parent is the project root+-- itself (@.@) — 'createDirectoryIfMissing' on @.@ is a no-op anyway.+ensureParentDir :: (Filesystem :> es) => FilePath -> Eff es ()+ensureParentDir dest =+  let parent = takeDirectory dest+   in case parent of+        "" -> pure ()+        "." -> pure ()+        d -> createDirectoryIfMissing True d++-- | Local copy of the prefix predicate used in 'Seihou.Effect.FilesystemPure'.+isPrefixOfPath :: String -> String -> Bool+isPrefixOfPath [] _ = True+isPrefixOfPath _ [] = False+isPrefixOfPath (x : xs) (y : ys) = x == y && isPrefixOfPath xs ys
+ src/Seihou/Engine/Plan.hs view
@@ -0,0 +1,369 @@+module Seihou.Engine.Plan+  ( compilePlan,+    parentDirs,+  )+where++import Control.Exception (IOException, SomeException, catch, try)+import Data.Aeson qualified as Aeson+import Data.Aeson.Encode.Pretty qualified as AesonPretty+import Data.Set qualified as Set+import Data.Text qualified as T+import Data.Text.Encoding qualified as TE+import Data.Text.IO qualified as TIO+import Data.Text.Lazy qualified as TL+import Data.Text.Lazy.Encoding qualified as TLE+import Data.Void (Void)+import Data.Yaml qualified as Yaml+import Dhall qualified+import Dhall.Core qualified as DhallCore+import Dhall.Src (Src)+import Seihou.Core.Expr (evalExpr)+import Seihou.Core.Path (validateProjectRelativePath)+import Seihou.Core.Types+import Seihou.Engine.DhallJSON (dhallExprToJSON)+import Seihou.Engine.Template (renderCommand, renderDestPath, renderTemplate, renderTemplateText)+import Seihou.Prelude+import System.FilePath (takeDirectory, takeExtension)++-- | Compile a module's steps into a list of filesystem operations.+-- Evaluates @when@ conditions, dispatches by strategy, reads source files,+-- renders templates, and expands destination paths.+compilePlan ::+  FilePath -> -- Module base directory (containing @files/@)+  Module ->+  Map VarName VarValue -> -- Resolved variable values+  IO (Either [Text] [Operation])+compilePlan baseDir modul vars = do+  let modName = modul.name+  results <- mapM (compileStep baseDir modName vars) modul.steps+  let (allErrors, allOps) = partitionResults results+  if null allErrors+    then case compileCommands vars modul.commands of+      Left cmdErrs -> pure (Left cmdErrs)+      Right cmdOps -> pure (Right (deduplicateDirs (concat allOps) ++ cmdOps))+    else pure (Left (concat allErrors))++-- | Compile commands into 'RunCommandOp' operations, interpolating+-- @{{var}}@ placeholders in the @run@ and @workDir@ fields.+-- Commands whose @when@ condition evaluates to False are skipped.+compileCommands :: Map VarName VarValue -> [Command] -> Either [Text] [Operation]+compileCommands vars = foldl' go (Right [])+  where+    go (Left errs) cmd = Left (errs ++ compileErrors cmd)+    go (Right ops) cmd =+      let shouldRun = case cmd.condition of+            Nothing -> True+            Just expr -> evalExpr vars expr+       in if shouldRun+            then case compileOneCommand vars cmd of+              Left cmdErrs -> Left cmdErrs+              Right op -> Right (ops ++ [op])+            else Right ops++    compileErrors cmd = case compileOneCommand vars cmd of+      Left es -> es+      Right _ -> []++-- | Compile a single command, interpolating placeholders in @run@ and @workDir@.+compileOneCommand :: Map VarName VarValue -> Command -> Either [Text] Operation+compileOneCommand vars cmd =+  case renderCommand cmd.run vars of+    Left placeholderErrors -> Left (map formatPlaceholderError placeholderErrors)+    Right runText ->+      case cmd.workDir of+        Nothing -> Right (RunCommandOp runText Nothing)+        Just wd ->+          case renderCommand wd vars of+            Left placeholderErrors -> Left (map formatPlaceholderError placeholderErrors)+            Right renderedWd ->+              case validateRenderedCommandWorkDir renderedWd of+                Left err -> Left [err]+                Right safeWd -> Right (RunCommandOp runText (Just (T.unpack safeWd)))++-- | Compile a single step into operations (or skip it).+-- If the step has a patch operation, it produces a 'PatchFileOp'; otherwise+-- dispatches by strategy to produce a 'WriteFileOp'.+compileStep ::+  FilePath ->+  ModuleName ->+  Map VarName VarValue ->+  Step ->+  IO (Either [Text] [Operation])+compileStep baseDir modName vars step = do+  -- Evaluate the when condition+  let shouldRun = case step.condition of+        Nothing -> True+        Just expr -> evalExpr vars expr+  if not shouldRun+    then pure (Right [])+    else case step.patch of+      Just _ -> compilePatchStep baseDir vars modName step+      Nothing -> case step.strategy of+        Copy -> compileCopyStep baseDir vars step+        Template -> compileTemplateStep baseDir vars step+        DhallText -> compileDhallTextStep baseDir vars step+        Structured -> compileStructuredStep baseDir vars step++-- | Compile a Copy step: read the source file and write it to the destination.+compileCopyStep ::+  FilePath ->+  Map VarName VarValue ->+  Step ->+  IO (Either [Text] [Operation])+compileCopyStep baseDir vars step = do+  let srcPath = baseDir </> "files" </> step.src+  result <- tryReadFile srcPath+  case result of+    Left err -> pure (Left [err])+    Right content ->+      case renderDestPath step.dest vars of+        Left placeholderErrors ->+          pure (Left (map formatPlaceholderError placeholderErrors))+        Right dest ->+          pure (writeFileOps dest content Copy)++-- | Compile a Template step: read, render placeholders, write.+compileTemplateStep ::+  FilePath ->+  Map VarName VarValue ->+  Step ->+  IO (Either [Text] [Operation])+compileTemplateStep baseDir vars step = do+  let srcPath = baseDir </> "files" </> step.src+  result <- tryReadFile srcPath+  case result of+    Left err -> pure (Left [err])+    Right content ->+      case renderTemplateText content vars of+        Left placeholderErrors ->+          pure (Left (map formatPlaceholderError placeholderErrors))+        Right rendered ->+          case renderDestPath step.dest vars of+            Left placeholderErrors ->+              pure (Left (map formatPlaceholderError placeholderErrors))+            Right dest ->+              pure (writeFileOps dest rendered Template)++-- | Compile a DhallText step: read source, substitute placeholders, evaluate as Dhall.+compileDhallTextStep ::+  FilePath ->+  Map VarName VarValue ->+  Step ->+  IO (Either [Text] [Operation])+compileDhallTextStep baseDir vars step = do+  let srcPath = baseDir </> "files" </> step.src+  result <- tryReadFile srcPath+  case result of+    Left err -> pure (Left [err])+    Right content ->+      case renderTemplate content vars of+        Left placeholderErrors ->+          pure (Left (map formatPlaceholderError placeholderErrors))+        Right substituted -> do+          dhallResult <- renderDhallText substituted+          case dhallResult of+            Left err -> pure (Left [err])+            Right evaluated ->+              case renderDestPath step.dest vars of+                Left placeholderErrors ->+                  pure (Left (map formatPlaceholderError placeholderErrors))+                Right dest ->+                  pure (writeFileOps dest evaluated DhallText)++-- | Compile a Structured step: read source, substitute placeholders, evaluate as Dhall,+-- then serialize to JSON or YAML based on the destination file extension.+compileStructuredStep ::+  FilePath ->+  Map VarName VarValue ->+  Step ->+  IO (Either [Text] [Operation])+compileStructuredStep baseDir vars step = do+  let srcPath = baseDir </> "files" </> step.src+  result <- tryReadFile srcPath+  case result of+    Left err -> pure (Left [err])+    Right content ->+      case renderTemplate content vars of+        Left placeholderErrors ->+          pure (Left (map formatPlaceholderError placeholderErrors))+        Right substituted -> do+          dhallResult <- evaluateDhallExpr substituted+          case dhallResult of+            Left err -> pure (Left [err])+            Right dhallExpr ->+              case dhallExprToJSON dhallExpr of+                Left err -> pure (Left [err])+                Right jsonValue ->+                  case renderDestPath step.dest vars of+                    Left placeholderErrors ->+                      pure (Left (map formatPlaceholderError placeholderErrors))+                    Right dest ->+                      case validateRenderedDestination dest of+                        Left err -> pure (Left [err])+                        Right safeDest ->+                          case serializeByExtension (T.unpack safeDest) jsonValue of+                            Left err -> pure (Left [err])+                            Right serialized -> pure (Right (writeFileOpsUnchecked safeDest serialized Structured))++-- | Compile a patch step: read source, render template, produce PatchFileOp.+-- The content rendering follows the step's strategy (Template renders placeholders,+-- Copy uses raw content, DhallText evaluates as Dhall).+compilePatchStep ::+  FilePath ->+  Map VarName VarValue ->+  ModuleName ->+  Step ->+  IO (Either [Text] [Operation])+compilePatchStep baseDir vars modName step = do+  let srcPath = baseDir </> "files" </> step.src+      patchOp' = case step.patch of+        Just p -> p+        Nothing -> error "compilePatchStep called without patch op"+  result <- tryReadFile srcPath+  case result of+    Left err -> pure (Left [err])+    Right rawContent -> do+      -- Render content based on strategy+      contentResult <- case step.strategy of+        Copy -> pure (Right rawContent)+        Template ->+          pure $ case renderTemplateText rawContent vars of+            Left placeholderErrors -> Left (map formatPlaceholderError placeholderErrors)+            Right rendered -> Right rendered+        DhallText -> do+          case renderTemplate rawContent vars of+            Left placeholderErrors -> pure (Left (map formatPlaceholderError placeholderErrors))+            Right substituted -> do+              dhallResult <- renderDhallText substituted+              case dhallResult of+                Left err -> pure (Left [err])+                Right evaluated -> pure (Right evaluated)+        Structured ->+          pure (Left ["Structured strategy cannot be used with patch operations"])+      case contentResult of+        Left errs -> pure (Left errs)+        Right content ->+          case renderDestPath step.dest vars of+            Left placeholderErrors ->+              pure (Left (map formatPlaceholderError placeholderErrors))+            Right dest ->+              pure (patchFileOps dest content patchOp' step.strategy modName)++-- | Evaluate a Dhall expression and return the normalized AST.+evaluateDhallExpr :: Text -> IO (Either Text (DhallCore.Expr Src Void))+evaluateDhallExpr dhallSource = do+  result <- try (Dhall.inputExpr dhallSource)+  case result of+    Left (e :: SomeException) ->+      pure (Left ("Dhall evaluation failed: " <> T.pack (show e)))+    Right expr -> pure (Right expr)++-- | Serialize a JSON Value to Text based on the destination file extension.+-- .json → pretty-printed JSON; .yaml or .yml → YAML; other → error.+serializeByExtension :: FilePath -> Aeson.Value -> Either Text Text+serializeByExtension dest value =+  case takeExtension dest of+    ".json" -> Right (TL.toStrict (TLE.decodeUtf8 (AesonPretty.encodePretty value)) <> "\n")+    ".yaml" -> Right (TE.decodeUtf8 (Yaml.encode value))+    ".yml" -> Right (TE.decodeUtf8 (Yaml.encode value))+    ext -> Left ("Structured strategy: unsupported output format '" <> T.pack ext <> "' (expected .json, .yaml, or .yml)")++-- | Evaluate a Dhall expression that produces Text.+renderDhallText :: Text -> IO (Either Text Text)+renderDhallText dhallSource = do+  result <- try (Dhall.input Dhall.strictText dhallSource)+  case result of+    Left (e :: SomeException) ->+      pure (Left ("Dhall evaluation failed: " <> T.pack (show e)))+    Right t -> pure (Right t)++validateRenderedDestination :: Text -> Either Text Text+validateRenderedDestination dest =+  case validateProjectRelativePath dest of+    Left err -> Left ("rendered destination " <> err)+    Right safePath -> Right (T.pack safePath)++validateRenderedCommandWorkDir :: Text -> Either Text Text+validateRenderedCommandWorkDir workDir =+  case validateProjectRelativePath workDir of+    Left err -> Left ("rendered command workDir " <> err)+    Right safePath -> Right (T.pack safePath)++writeFileOps :: Text -> Text -> Strategy -> Either [Text] [Operation]+writeFileOps dest content strategy =+  case validateRenderedDestination dest of+    Left err -> Left [err]+    Right safeDest -> Right (writeFileOpsUnchecked safeDest content strategy)++writeFileOpsUnchecked :: Text -> Text -> Strategy -> [Operation]+writeFileOpsUnchecked dest content strategy =+  let destStr = T.unpack dest+      dirOps = map (CreateDirOp . T.unpack) (parentDirs dest)+   in dirOps ++ [WriteFileOp destStr content strategy]++patchFileOps :: Text -> Text -> PatchOp -> Strategy -> ModuleName -> Either [Text] [Operation]+patchFileOps dest content patchOp' strategy modName =+  case validateRenderedDestination dest of+    Left err -> Left [err]+    Right safeDest ->+      let destStr = T.unpack safeDest+          dirOps = map (CreateDirOp . T.unpack) (parentDirs safeDest)+       in Right (dirOps ++ [PatchFileOp destStr content patchOp' strategy modName])++-- | Extract parent directories from a path.+-- @"src/Lib.hs"@ produces @["src"]@.+-- @"a/b/c.txt"@ produces @["a", "a/b"]@.+parentDirs :: Text -> [Text]+parentDirs path =+  let dir = T.pack (takeDirectory (T.unpack path))+   in if dir == "." || T.null dir+        then []+        else buildChain dir++-- | Build the chain of parent directories.+-- @"a/b"@ produces @["a", "a/b"]@.+buildChain :: Text -> [Text]+buildChain dir =+  let parts = T.splitOn "/" dir+      prefixes = drop 1 (scanl (\acc p -> acc <> "/" <> p) "" parts)+      trimmed = map (T.drop 1) prefixes -- remove leading /+   in trimmed++-- | Try to read a file, returning an error message on failure.+tryReadFile :: FilePath -> IO (Either Text Text)+tryReadFile path =+  (Right <$> TIO.readFile path) `catch` handler+  where+    handler :: IOException -> IO (Either Text Text)+    handler e = pure (Left ("failed to read file: " <> T.pack path <> ": " <> T.pack (show e)))++-- | Format a placeholder error as a human-readable text message.+formatPlaceholderError :: PlaceholderError -> Text+formatPlaceholderError (UnresolvedPlaceholder (VarName name) lineNum) =+  "unresolved placeholder '{{" <> name <> "}}' at line " <> T.pack (show lineNum)+formatPlaceholderError (MalformedPlaceholder raw lineNum) =+  "malformed placeholder '" <> raw <> "' at line " <> T.pack (show lineNum)+formatPlaceholderError (UnterminatedIf lineNum) =+  "unterminated {{#if}} opened at line " <> T.pack (show lineNum)+formatPlaceholderError (OrphanBlockToken tok lineNum) =+  "stray " <> tok <> " at line " <> T.pack (show lineNum)+formatPlaceholderError (MalformedIfExpression expr lineNum parseErr) =+  "malformed {{#if}} expression '" <> expr <> "' at line " <> T.pack (show lineNum) <> ": " <> parseErr++-- | Deduplicate CreateDirOp operations while preserving order.+deduplicateDirs :: [Operation] -> [Operation]+deduplicateDirs = go Set.empty+  where+    go _ [] = []+    go seen (op@(CreateDirOp p) : rest)+      | p `Set.member` seen = go seen rest+      | otherwise = op : go (Set.insert p seen) rest+    go seen (op : rest) = op : go seen rest++-- | Partition a list of Either into errors and successes.+partitionResults :: [Either e a] -> ([e], [a])+partitionResults = foldr step ([], [])+  where+    step (Left e) (errs, oks) = (e : errs, oks)+    step (Right a) (errs, oks) = (errs, a : oks)
+ src/Seihou/Engine/Preview.hs view
@@ -0,0 +1,192 @@+module Seihou.Engine.Preview+  ( FileStatus (..),+    PreviewLine (..),+    buildPreview,+    renderPreviewPlain,+    formatPlanView,+  )+where++import Data.Map.Strict qualified as Map+import Data.Set qualified as Set+import Data.Text qualified as T+import Seihou.Core.Types+import Seihou.Prelude++-- | Status of a file relative to the manifest and disk.+data FileStatus+  = FsNew+  | FsModified+  | FsUnchanged+  | FsConflict+  | FsOrphaned+  | FsUnknown+  deriving stock (Eq, Show)++-- | One line in the dry-run preview.+data PreviewLine+  = FilePreview+      { previewStatus :: FileStatus,+        previewPath :: FilePath,+        previewAnnotation :: Text,+        previewModule :: Maybe ModuleName+      }+  | DirPreview FilePath+  | CommandPreview Text+  | OrphanPreview FilePath ModuleName+  deriving stock (Eq, Show)++-- | Build a structured preview from operations and an optional diff result.+-- The ownership map tracks which module produced each file path.+-- When no DiffResult is provided (first run, no manifest), all file+-- operations are treated as new.+buildPreview :: [Operation] -> Maybe DiffResult -> Map FilePath ModuleName -> [PreviewLine]+buildPreview ops mDiff ownerMap =+  let opLines = map (opToPreview mDiff ownerMap) ops+      orphanLines = case mDiff of+        Nothing -> []+        Just diff ->+          -- Only include orphans whose path is NOT produced by any operation+          let producedPaths = Set.fromList [p | op <- ops, Just p <- [destOfOp op]]+           in [ OrphanPreview o.path o.moduleName+              | o <- diff.orphaned,+                not (Set.member o.path producedPaths)+              ]+   in opLines ++ orphanLines++-- | Convert a single operation to a preview line.+opToPreview :: Maybe DiffResult -> Map FilePath ModuleName -> Operation -> PreviewLine+opToPreview mDiff ownerMap (WriteFileOp dest _ strat) =+  FilePreview+    { previewStatus = lookupStatus dest mDiff,+      previewPath = dest,+      previewAnnotation = strategyName strat,+      previewModule = Map.lookup dest ownerMap+    }+opToPreview _ _ (CreateDirOp path) = DirPreview path+opToPreview mDiff ownerMap (CopyFileOp _ dest) =+  FilePreview+    { previewStatus = lookupStatus dest mDiff,+      previewPath = dest,+      previewAnnotation = "copy",+      previewModule = Map.lookup dest ownerMap+    }+opToPreview _ _ (RunCommandOp cmd _) = CommandPreview cmd+opToPreview mDiff ownerMap (PatchFileOp dest _ _patchOp' _ modName') =+  FilePreview+    { previewStatus = lookupStatus dest mDiff,+      previewPath = dest,+      previewAnnotation = "patch",+      previewModule = Just modName'+    }++-- | Look up a file's status in the diff result.+lookupStatus :: FilePath -> Maybe DiffResult -> FileStatus+lookupStatus _ Nothing = FsNew+lookupStatus path (Just diff)+  | any (\f -> f.path == path) diff.new = FsNew+  | any (\f -> f.path == path) diff.modified = FsModified+  | path `elem` diff.unchanged = FsUnchanged+  | any (\f -> f.path == path) diff.conflicts = FsConflict+  | any (\f -> f.path == path) diff.orphaned = FsOrphaned+  | otherwise = FsUnknown++-- | Render preview lines as plain text (no ANSI codes).+renderPreviewPlain :: [PreviewLine] -> Text+renderPreviewPlain lines' =+  if null lines'+    then "No operations to perform.\n"+    else T.unlines (map (renderPlainLine maxPathLen) fileLines ++ map renderNonFileLine nonFileLines)+  where+    fileLines = [l | l@(FilePreview {}) <- lines']+    nonFileLines = [l | l <- lines', not (isFileLine l)]+    maxPathLen = maximum (0 : map (T.length . T.pack . (.previewPath)) fileLines)++renderPlainLine :: Int -> PreviewLine -> Text+renderPlainLine maxPath (FilePreview status path annotation mMod) =+  let pathText = T.pack path+      pathPad = T.replicate (maxPath - T.length pathText) " "+      modSuffix = case mMod of+        Just mn -> ", " <> mn.unModuleName+        Nothing -> ""+   in "    " <> statusTag status <> "  " <> pathText <> pathPad <> "  (" <> annotation <> modSuffix <> ")"+renderPlainLine _ other = renderNonFileLine other++renderNonFileLine :: PreviewLine -> Text+renderNonFileLine (DirPreview path) =+  "    mkdir  " <> T.pack path+renderNonFileLine (CommandPreview cmd) =+  "    run    " <> cmd+renderNonFileLine (OrphanPreview path modName') =+  "    [orphaned]  " <> T.pack path <> "  (orphaned from " <> modName'.unModuleName <> ")"+renderNonFileLine _ = ""++isFileLine :: PreviewLine -> Bool+isFileLine (FilePreview {}) = True+isFileLine _ = False++statusTag :: FileStatus -> Text+statusTag FsNew = "[new]"+statusTag FsModified = "[modified]"+statusTag FsUnchanged = "[unchanged]"+statusTag FsConflict = "[conflict]"+statusTag FsOrphaned = "[orphaned]"+statusTag FsUnknown = "[unknown]"++strategyName :: Strategy -> Text+strategyName Copy = "copy"+strategyName Template = "template"+strategyName DhallText = "dhall-text"+strategyName Structured = "structured"++-- | Format a complete plan view with header, variables, operations, and summary.+formatPlanView :: [ModuleName] -> Map VarName VarValue -> [PreviewLine] -> DiffResult -> Text+formatPlanView moduleNames vars preview diff =+  T.unlines $+    [header, ""]+      ++ varsSection+      ++ ["  Operations:"]+      ++ map ("  " <>) (T.lines (renderPreviewPlain preview))+      ++ [""]+      ++ [summaryText]+  where+    header =+      "Generation Plan ("+        <> T.intercalate " + " (map (.unModuleName) moduleNames)+        <> "):"++    varsSection =+      if Map.null vars+        then []+        else+          "  Variables:"+            : map formatVar (Map.toAscList vars)+            ++ [""]++    maxVarLen = maximum (0 : map (\(VarName n, _) -> T.length n) (Map.toAscList vars))++    formatVar (VarName name, val) =+      let namePad = T.replicate (maxVarLen - T.length name) " "+       in "    " <> name <> namePad <> " = " <> showVarValue val++    showVarValue (VText t) = "\"" <> t <> "\""+    showVarValue (VBool True) = "true"+    showVarValue (VBool False) = "false"+    showVarValue (VInt n) = T.pack (show n)+    showVarValue (VList vs) = "[" <> T.intercalate ", " (map showVarValue vs) <> "]"++    nFiles = length diff.new + length diff.modified+    nConflicts = length diff.conflicts+    summaryText =+      "  "+        <> T.pack (show nFiles)+        <> " files to write, "+        <> T.pack (show nConflicts)+        <> " conflicts"++-- | Extract the destination path from a file-producing operation.+destOfOp :: Operation -> Maybe FilePath+destOfOp (WriteFileOp d _ _) = Just d+destOfOp (CopyFileOp _ d) = Just d+destOfOp (PatchFileOp d _ _ _ _) = Just d+destOfOp _ = Nothing
+ src/Seihou/Engine/Remove.hs view
@@ -0,0 +1,356 @@+module Seihou.Engine.Remove+  ( RemovalFile (..),+    RemovalPlan (..),+    RemovalError (..),+    RemovalOp (..),+    RemovalFileStatus (..),+    ExecutedRemovalPlan (..),+    computeRemovalPlan,+    executeRemoval,+    buildRemovalOps,+    executeRemovalOps,+  )+where++import Control.Monad (foldM)+import Data.List (nub, sortBy)+import Data.Map.Strict qualified as Map+import Data.Ord (Down (..))+import Data.Set (Set)+import Data.Set qualified as Set+import Data.Text qualified as T+import Data.Time (UTCTime)+import Seihou.Core.Path (validateProjectRelativePath)+import Seihou.Core.Types+import Seihou.Effect.Filesystem (Filesystem, doesFileExist, readFileText, removeDirectoryIfEmpty, removeFile, writeFileText)+import Seihou.Engine.Section (removeSection)+import Seihou.Manifest.Hash (hashContent)+import Seihou.Prelude+import System.FilePath (takeDirectory)++-- ============================================================+-- Legacy types (used by current CLI handler, Milestone 4 replaces)+-- ============================================================++-- | Classification of a file during removal planning.+data RemovalFile+  = -- | Disk hash matches manifest hash — safe to delete.+    RemovalSafe FilePath+  | -- | User modified the file since generation — needs confirmation.+    RemovalConflict FilePath+  | -- | File was already deleted from disk.+    RemovalGone FilePath+  deriving stock (Eq, Show)++-- | A plan describing what files to remove for a given module.+data RemovalPlan = RemovalPlan+  { targetModule :: ModuleName,+    files :: [RemovalFile]+  }+  deriving stock (Eq, Show)++-- ============================================================+-- New step-based removal types+-- ============================================================++-- | A concrete removal operation ready to execute.+data RemovalOp+  = -- | Delete a file, with its current status.+    DeleteFileOp FilePath RemovalFileStatus+  | -- | Strip this module's section markers from a file.+    StripSectionOp FilePath+  | -- | Apply a Dhall text function to rewrite a file.+    RewriteOp FilePath FilePath+  | -- | Run a shell command during removal.+    RemovalCommandOp Text (Maybe Text)+  deriving stock (Eq, Show)++-- | Status of a file targeted for deletion.+data RemovalFileStatus+  = -- | Disk hash matches manifest — safe to delete.+    RFSafe+  | -- | User modified the file since generation.+    RFConflict+  | -- | File already deleted from disk.+    RFGone+  deriving stock (Eq, Show)++-- | A removal plan built from declared removal steps.+data ExecutedRemovalPlan = ExecutedRemovalPlan+  { targetModule :: ModuleName,+    ops :: [RemovalOp]+  }+  deriving stock (Eq, Show)++-- | Errors that prevent removal.+data RemovalError+  = -- | The module is not in the manifest's applied modules list.+    ModuleNotApplied ModuleName+  | -- | The module has no removal specification.+    ModuleNotRemovable ModuleName+  | -- | A module-declared removal path would escape the project root.+    RemovalUnsafePath Text Text Text+  deriving stock (Eq, Show)++-- ============================================================+-- Legacy compute/execute (preserves current CLI behavior)+-- ============================================================++-- | Compute a removal plan for the given module.+-- Checks that the module is applied and has a removal spec, then classifies+-- each file it owns as safe, conflicted, or already gone.+computeRemovalPlan ::+  (Filesystem :> es) =>+  Manifest ->+  ModuleName ->+  Eff es (Either RemovalError RemovalPlan)+computeRemovalPlan manifest modName = do+  case findApplied manifest modName of+    Nothing -> pure (Left (ModuleNotApplied modName))+    Just am+      | Nothing <- am.removal -> pure (Left (ModuleNotRemovable modName))+      | otherwise -> do+          let ownedFiles = moduleFiles manifest modName+          classified <- mapM classifyForRemoval ownedFiles+          pure (Right (RemovalPlan {targetModule = modName, files = classified}))++-- | Execute a removal plan: delete files, clean up empty directories,+-- and return the updated manifest.+executeRemoval ::+  (Filesystem :> es) =>+  Manifest ->+  RemovalPlan ->+  Set FilePath ->+  UTCTime ->+  Eff es Manifest+executeRemoval manifest plan keepSet now = do+  let toDelete = filesToDelete plan keepSet+  mapM_ removeFile toDelete+  cleanupEmptyDirs toDelete+  pure (removeFromManifest manifest plan.targetModule now)++-- ============================================================+-- New step-based removal engine+-- ============================================================++-- | Build a list of removal operations from declared removal steps.+-- Classifies remove-file targets by checking the manifest and disk state.+buildRemovalOps ::+  (Filesystem :> es) =>+  Manifest ->+  ModuleName ->+  Removal ->+  Eff es (Either RemovalError ExecutedRemovalPlan)+buildRemovalOps manifest modName removal = do+  case findApplied manifest modName of+    Nothing -> pure (Left (ModuleNotApplied modName))+    Just _ -> do+      stepResults <- mapM (buildStepOp manifest modName) removal.removalSteps+      let cmdResults = map buildCommandOp removal.removalCommands+      pure $ do+        stepOps <- sequence stepResults+        cmdOps <- sequence cmdResults+        Right+          ExecutedRemovalPlan+            { targetModule = modName,+              ops = stepOps ++ cmdOps+            }++-- | Build a single removal operation from a removal step.+buildStepOp ::+  (Filesystem :> es) =>+  Manifest ->+  ModuleName ->+  RemovalStep ->+  Eff es (Either RemovalError RemovalOp)+buildStepOp manifest _modName step = case step.action of+  RemoveFileAction ->+    case validateRemovalPath "remove-file destination" step.dest of+      Left err -> pure (Left err)+      Right path -> do+        status <- classifyFileStatus manifest path+        pure (Right (DeleteFileOp path status))+  RemoveSectionAction ->+    pure $+      case validateRemovalPath "remove-section destination" step.dest of+        Left err -> Left err+        Right path -> Right (StripSectionOp path)+  RewriteFileAction ->+    pure $ do+      dest <- validateRemovalPath "rewrite-file destination" step.dest+      src <- case step.src of+        Just s -> validateRemovalPath "rewrite-file source" (T.pack s)+        Nothing -> Left (RemovalUnsafePath "rewrite-file source" "" "path must not be empty")+      Right (RewriteOp dest src)++buildCommandOp :: Command -> Either RemovalError RemovalOp+buildCommandOp command =+  case traverse (validateRemovalPath "remove-command workDir") command.workDir of+    Left err -> Left err+    Right safeWorkDir -> Right (RemovalCommandOp command.run (fmap T.pack safeWorkDir))++validateRemovalPath :: Text -> Text -> Either RemovalError FilePath+validateRemovalPath label path =+  case validateProjectRelativePath path of+    Left reason -> Left (RemovalUnsafePath label path reason)+    Right safePath -> Right safePath++-- | Classify a file's status for removal by comparing disk to manifest.+classifyFileStatus ::+  (Filesystem :> es) =>+  Manifest ->+  FilePath ->+  Eff es RemovalFileStatus+classifyFileStatus manifest path = do+  exists <- doesFileExist path+  if not exists+    then pure RFGone+    else case Map.lookup path manifest.files of+      Nothing -> pure RFSafe -- Not in manifest, treat as safe to delete+      Just rec -> do+        content <- readFileText path+        let diskHash = hashContent content+        if diskHash == rec.hash+          then pure RFSafe+          else pure RFConflict++-- | Execute a list of removal operations and return the updated manifest.+executeRemovalOps ::+  (Filesystem :> es) =>+  Manifest ->+  ExecutedRemovalPlan ->+  Set FilePath ->+  UTCTime ->+  Eff es Manifest+executeRemovalOps manifest plan keepSet now = do+  let modName = plan.targetModule+  deletedPaths <- foldM (execOp modName keepSet) [] plan.ops+  cleanupEmptyDirs deletedPaths+  pure (removeFromManifest manifest modName now)++-- | Execute a single removal operation. Returns accumulated deleted paths.+execOp ::+  (Filesystem :> es) =>+  ModuleName ->+  Set FilePath ->+  [FilePath] ->+  RemovalOp ->+  Eff es [FilePath]+execOp _ keepSet acc (DeleteFileOp path status) =+  if Set.member path keepSet+    then pure acc+    else case status of+      RFSafe -> do+        removeFile path+        pure (path : acc)+      RFConflict -> do+        -- Conflicts are deleted unless in keepSet (handled by CLI)+        removeFile path+        pure (path : acc)+      RFGone -> pure acc+execOp modName _ acc (StripSectionOp path) = do+  exists <- doesFileExist path+  if exists+    then do+      content <- readFileText path+      let prefix = guessCommentPrefix path+          cleaned = removeSection modName prefix content+      writeFileText path cleaned+      pure acc+    else pure acc+execOp _ _ acc (RewriteOp _ _) = do+  -- RewriteFileAction is deferred to a future milestone (requires Dhall eval)+  pure acc+execOp _ _ acc (RemovalCommandOp _ _) = do+  -- Commands are executed by the CLI handler, not the engine+  pure acc++-- | Guess the comment prefix for a file based on its extension.+guessCommentPrefix :: FilePath -> Text+guessCommentPrefix path+  | ".hs" `T.isSuffixOf` T.pack path = "--"+  | ".cabal" `T.isSuffixOf` T.pack path = "--"+  | ".yaml" `T.isSuffixOf` T.pack path = "#"+  | ".yml" `T.isSuffixOf` T.pack path = "#"+  | ".toml" `T.isSuffixOf` T.pack path = "#"+  | ".nix" `T.isSuffixOf` T.pack path = "#"+  | otherwise = "#"++-- ============================================================+-- Shared helpers+-- ============================================================++-- | Find an applied module by name.+findApplied :: Manifest -> ModuleName -> Maybe AppliedModule+findApplied manifest modName =+  case filter (\am -> am.name == modName) manifest.modules of+    (am : _) -> Just am+    [] -> Nothing++-- | Get the file paths owned by a module in the manifest.+moduleFiles :: Manifest -> ModuleName -> [(FilePath, FileRecord)]+moduleFiles manifest modName =+  [ (path, rec)+  | (path, rec) <- Map.toList manifest.files,+    rec.moduleName == modName+  ]++-- | Classify a single file for removal (legacy).+classifyForRemoval :: (Filesystem :> es) => (FilePath, FileRecord) -> Eff es RemovalFile+classifyForRemoval (path, rec) = do+  exists <- doesFileExist path+  if not exists+    then pure (RemovalGone path)+    else do+      content <- readFileText path+      let diskHash = hashContent content+      if diskHash == rec.hash+        then pure (RemovalSafe path)+        else pure (RemovalConflict path)++-- | Determine which files should actually be deleted.+filesToDelete :: RemovalPlan -> Set FilePath -> [FilePath]+filesToDelete plan keepSet =+  [ path+  | rf <- plan.files,+    let path = removalFilePath rf,+    shouldDelete rf,+    not (Set.member path keepSet)+  ]+  where+    shouldDelete (RemovalSafe _) = True+    shouldDelete (RemovalConflict _) = True+    shouldDelete (RemovalGone _) = False++-- | Extract the path from a RemovalFile.+removalFilePath :: RemovalFile -> FilePath+removalFilePath (RemovalSafe p) = p+removalFilePath (RemovalConflict p) = p+removalFilePath (RemovalGone p) = p++-- | After deleting files, try to remove their now-empty parent directories.+-- Walks parents bottom-up (deepest first) to correctly cascade.+cleanupEmptyDirs :: (Filesystem :> es) => [FilePath] -> Eff es ()+cleanupEmptyDirs paths = do+  let parentDirs = nub $ concatMap allParents paths+      -- Sort deepest-first so children are removed before parents+      sorted = sortBy (\a b -> compare (Down (length a)) (Down (length b))) parentDirs+  mapM_ removeDirectoryIfEmpty sorted++-- | Get all parent directories of a path, excluding "." and "".+allParents :: FilePath -> [FilePath]+allParents path = go (takeDirectory path)+  where+    go "." = []+    go "" = []+    go "/" = []+    go dir = dir : go (takeDirectory dir)++-- | Remove a module and its files from the manifest.+removeFromManifest :: Manifest -> ModuleName -> UTCTime -> Manifest+removeFromManifest manifest modName now =+  manifest+    { modules = filter (\am -> am.name /= modName) manifest.modules,+      files = Map.filter (\rec -> rec.moduleName /= modName) manifest.files,+      genAt = now+    }
+ src/Seihou/Engine/Section.hs view
@@ -0,0 +1,104 @@+module Seihou.Engine.Section+  ( SectionMarker (..),+    renderSectionOpen,+    renderSectionClose,+    wrapInSection,+    removeSection,+    applyTextPatch,+  )+where++import Data.Text qualified as T+import Seihou.Core.Types+import Seihou.Prelude++-- | A section marker identifies content contributed by a module.+data SectionMarker = SectionMarker+  { sectionPrefix :: Text,+    sectionModule :: ModuleName+  }+  deriving stock (Eq, Show)++-- | Render an opening section marker line.+-- Result: @"# --- seihou:haskell-base ---\\n"@+renderSectionOpen :: SectionMarker -> Text+renderSectionOpen marker =+  marker.sectionPrefix <> " --- seihou:" <> marker.sectionModule.unModuleName <> " ---\n"++-- | Render a closing section marker line.+-- Result: @"# --- /seihou:haskell-base ---\\n"@+renderSectionClose :: SectionMarker -> Text+renderSectionClose marker =+  marker.sectionPrefix <> " --- /seihou:" <> marker.sectionModule.unModuleName <> " ---\n"++-- | Wrap content in section markers.+wrapInSection :: SectionMarker -> Text -> Text+wrapInSection marker content =+  renderSectionOpen marker <> content <> ensureTrailingNewline content <> renderSectionClose marker+  where+    ensureTrailingNewline t+      | T.null t = ""+      | T.last t == '\n' = ""+      | otherwise = "\n"++-- | Remove a module's section from file content.+--+-- Strips all lines between the opening and closing section markers (inclusive)+-- for the given module name. The comment prefix (e.g., @"#"@) determines+-- the marker format. If no matching markers are found, the content is returned+-- unchanged. Cleans up resulting double blank lines.+removeSection :: ModuleName -> Text -> Text -> Text+removeSection modName prefix content =+  let marker = SectionMarker {sectionPrefix = prefix, sectionModule = modName}+      openTag = T.stripEnd (renderSectionOpen marker)+      closeTag = T.stripEnd (renderSectionClose marker)+      ls = T.lines content+      filtered = dropSection openTag closeTag ls+      cleaned = collapseBlankLines filtered+   in if null cleaned+        then ""+        else T.unlines cleaned+  where+    dropSection _ _ [] = []+    dropSection open close (l : rest)+      | T.stripEnd l == open =+          -- Skip until we find the close tag+          case dropWhile (\x -> T.stripEnd x /= close) rest of+            [] -> [] -- Close tag not found, drop remaining+            (_ : after) -> dropSection open close after+      | otherwise = l : dropSection open close rest++    collapseBlankLines [] = []+    collapseBlankLines [x] = [x]+    collapseBlankLines (x : y : rest)+      | T.null (T.strip x) && T.null (T.strip y) = collapseBlankLines (y : rest)+      | otherwise = x : collapseBlankLines (y : rest)++-- | Apply a patch operation to existing content.+--+-- @applyTextPatch patchOp moduleName commentPrefix existingContent newContent@+--+-- Returns the merged content or an error.+applyTextPatch :: PatchOp -> ModuleName -> Text -> Text -> Text -> Either Text Text+applyTextPatch AppendFile _ _ existing new =+  Right (ensureTrailingNewline existing <> new)+applyTextPatch PrependFile _ _ existing new =+  Right (ensureTrailingNewline new <> existing)+applyTextPatch AppendSection modName prefix existing new =+  let marker = SectionMarker {sectionPrefix = prefix, sectionModule = modName}+   in Right (ensureTrailingNewline existing <> wrapInSection marker new)+applyTextPatch AppendLineIfAbsent _ _ existing new =+  let existingLines = map T.stripEnd (T.lines existing)+      newLines = filter (not . T.null . T.strip) (T.lines (T.stripEnd new))+      missing = filter (\l -> T.stripEnd l `notElem` existingLines) newLines+   in if null missing+        then Right existing+        else Right (ensureTrailingNewline existing <> T.unlines missing)++-- | Ensure text ends with a newline. Returns the text unchanged if it already+-- ends with one, or with an appended newline if not. Returns empty text unchanged.+ensureTrailingNewline :: Text -> Text+ensureTrailingNewline t+  | T.null t = t+  | T.last t == '\n' = t+  | otherwise = t <> "\n"
+ src/Seihou/Engine/Template.hs view
@@ -0,0 +1,373 @@+module Seihou.Engine.Template+  ( renderTemplate,+    renderTemplateText,+    expandConditionals,+    extractIfExprs,+    valueToText,+    renderDestPath,+    renderCommand,+  )+where++import Data.Map.Strict qualified as Map+import Data.Text qualified as T+import Seihou.Core.Expr (evalExpr, parseExpr)+import Seihou.Core.Types+import Seihou.Prelude++-- | Convert a variable value to its text representation for template output.+valueToText :: VarValue -> Text+valueToText (VText t) = t+valueToText (VBool True) = "true"+valueToText (VBool False) = "false"+valueToText (VInt n) = T.pack (show n)+valueToText (VList vs) = T.intercalate "," (map valueToText vs)++-- | Render a template by substituting @{{placeholder}}@ occurrences.+-- The escape sequence @\\{{@ produces a literal @{{@ in the output.+-- Returns either a list of errors or the rendered text.+renderTemplate :: Text -> Map VarName VarValue -> Either [PlaceholderError] Text+renderTemplate template vars =+  let lns = T.splitOn "\n" template+      results = zipWith (renderLine vars) [1 ..] lns+      (allErrors, renderedLines) = partitionResults results+   in if null allErrors+        then Right (T.intercalate "\n" renderedLines)+        else Left (concat allErrors)++-- | Render a template body supporting both @{{placeholder}}@ substitution+-- and @{{#if}}\/{{#else}}\/{{\/if}}@ conditional blocks with unbounded+-- nesting. Expression syntax inside @{{#if …}}@ is the same grammar used+-- by a step's @when@ clause ('Seihou.Core.Expr.parseExpr').+--+-- Runs in two passes: 'expandConditionals' consumes block tokens and+-- emits plain template text, then 'renderTemplate' performs @{{var}}@+-- substitution on the expanded text.+--+-- Intended for template bodies only. Destination paths and shell+-- commands stay on 'renderDestPath' \/ 'renderCommand'.+renderTemplateText :: Text -> Map VarName VarValue -> Either [PlaceholderError] Text+renderTemplateText template vars =+  case expandConditionals vars template of+    Left errs -> Left errs+    Right expanded -> renderTemplate expanded vars++-- | Extract the raw expression text from every @{{#if …}}@ opener in a+-- template body, in document order. Used by authoring-time lint to scan+-- template conditionals without expanding them; each returned string is+-- intended to be fed to 'parseExpr'. Nesting is irrelevant here — every+-- opener is reported, regardless of depth. A malformed (unterminated)+-- opener stops the scan, mirroring 'splitNextBlock'.+extractIfExprs :: Text -> [Text]+extractIfExprs = go+  where+    go t = case T.breakOn "{{#if " t of+      (_, "") -> []+      (_, match) ->+        let afterOpen = T.drop 6 match -- skip "{{#if "+         in case T.breakOn "}}" afterOpen of+              (_, "") -> [] -- unterminated opener; stop+              (exprRaw, rest) -> T.strip exprRaw : go (T.drop 2 rest)++-- | Render destination path placeholders (same substitution logic).+renderDestPath :: Text -> Map VarName VarValue -> Either [PlaceholderError] Text+renderDestPath = renderTemplate++-- | Render placeholders in a shell command string.+-- Same substitution as 'renderTemplate' but named for clarity at call sites.+renderCommand :: Text -> Map VarName VarValue -> Either [PlaceholderError] Text+renderCommand = renderTemplate++-- | Render a single line, returning errors or the rendered text.+renderLine :: Map VarName VarValue -> Int -> Text -> Either [PlaceholderError] Text+renderLine vars lineNum line =+  case scanLine vars lineNum line of+    ([], rendered) -> Right rendered+    (errs, _) -> Left errs++-- | Scan a line for placeholders and substitute them.+-- Returns accumulated errors and the rendered text.+scanLine :: Map VarName VarValue -> Int -> Text -> ([PlaceholderError], Text)+scanLine vars lineNum = go+  where+    go :: Text -> ([PlaceholderError], Text)+    go txt+      | T.null txt = ([], "")+      | "\\{{" `T.isPrefixOf` txt =+          -- Escape sequence: produce literal {{+          let (errs, rest) = go (T.drop 3 txt)+           in (errs, "{{" <> rest)+      | "{{" `T.isPrefixOf` txt =+          -- Placeholder: find the closing }}+          let after = T.drop 2 txt+           in case T.breakOn "}}" after of+                (_, "") ->+                  -- No closing }}, treat as malformed+                  let raw = T.take 20 txt+                      (errs, rest) = go (T.drop 2 txt)+                   in (MalformedPlaceholder raw lineNum : errs, rest)+                (varNameText, remaining) ->+                  let trimmed = T.strip varNameText+                      name = VarName trimmed+                      restAfter = T.drop 2 remaining -- skip the }}+                   in case Map.lookup name vars of+                        Just val ->+                          let (errs, rest) = go restAfter+                           in (errs, valueToText val <> rest)+                        Nothing ->+                          let (errs, rest) = go restAfter+                           in (UnresolvedPlaceholder name lineNum : errs, rest)+      | otherwise =+          -- Find the next {{ or \{{ occurrence+          case findNextPlaceholder txt of+            Nothing -> ([], txt)+            Just idx ->+              let (before, after) = T.splitAt idx txt+                  (errs, rest) = go after+               in (errs, before <> rest)++-- | Find the index of the next placeholder start (@{{@ or @\\{{@).+findNextPlaceholder :: Text -> Maybe Int+findNextPlaceholder txt = go 0 txt+  where+    go :: Int -> Text -> Maybe Int+    go idx t+      | T.null t = Nothing+      | "\\{{" `T.isPrefixOf` t = Just idx+      | "{{" `T.isPrefixOf` t = Just idx+      | otherwise = go (idx + 1) (T.drop 1 t)++-- | Partition a list of Either into errors and successes.+partitionResults :: [Either e a] -> ([e], [a])+partitionResults = foldr step ([], [])+  where+    step (Left e) (errs, oks) = (e : errs, oks)+    step (Right a) (errs, oks) = (errs, a : oks)++-- | First-pass expander: consume @{{#if}}\/{{#else}}\/{{\/if}}@ block+-- tokens and emit plain template text with only the selected branches+-- retained. Supports arbitrary nesting depth.+--+-- Exported for test access; in production code the recommended entry+-- point is 'renderTemplateText'.+expandConditionals :: Map VarName VarValue -> Text -> Either [PlaceholderError] Text+expandConditionals vars = expandAtTopLevel vars 1++-- | Expand at the top level: produce text until we hit @{{\/if}}@ or+-- @{{#else}}@ (which at top level are orphans). Only the selected+-- branch is expanded; the untaken branch is discarded, so errors+-- inside it do not surface.+--+-- When a block tag is the only non-whitespace on its line (a+-- \"standalone block\" in the Mustache/Handlebars sense), the+-- surrounding indentation and the line\'s terminating newline are+-- consumed as part of the tag so the expanded text does not leave a+-- blank line behind. This is what lets module authors format a+-- template with tags on their own lines and still get clean output.+expandAtTopLevel :: Map VarName VarValue -> Int -> Text -> Either [PlaceholderError] Text+expandAtTopLevel vars startLine input =+  case splitNextBlock input of+    NoBlockLeft -> Right input+    FoundIf before0 afterBlockOpen0 exprText ->+      let beforeLines = T.count "\n" before0+          openAt = startLine + beforeLines+          (before, afterBlockOpen, openerSkipped) =+            trimStandaloneAround before0 afterBlockOpen0+          bodyStart = openAt + openerSkipped+       in case parseExpr exprText of+            Left parseErr ->+              Left [MalformedIfExpression exprText openAt parseErr]+            Right expr -> do+              (thenText, elseText, afterBlock, consumedLines, closerSkipped) <-+                splitBranches openAt afterBlockOpen+              let selectedRaw =+                    if evalExpr vars expr then thenText else elseText+              selectedExpanded <- expandAtTopLevel vars bodyStart selectedRaw+              let afterLine = openAt + openerSkipped + consumedLines + closerSkipped+              rest <- expandAtTopLevel vars afterLine afterBlock+              pure (before <> selectedExpanded <> rest)+    FoundOrphan tok beforeLines ->+      Left [OrphanBlockToken tok (startLine + beforeLines)]++-- | Raw tokenisation result for the top-level scan.+data NextBlock+  = -- | No block tokens in the remaining input.+    NoBlockLeft+  | -- | An @{{#if …}}@ block. @before@ is text preceding the opener;+    -- @after@ is everything after the closing @}}@ of the opener+    -- (i.e. the body plus whatever follows the matching @{{/if}}@);+    -- @expr@ is the raw expression text.+    FoundIf+      { foundBefore :: Text,+        foundAfter :: Text,+        foundExpr :: Text+      }+  | -- | A @{{#else}}@ or @{{/if}}@ encountered before any matching+    -- @{{#if}}@ at the current depth. The 'Int' is the line offset+    -- (0-based) from the start of the scanned region.+    FoundOrphan Text Int++-- | Scan @input@ for the next block token at the outer level (i.e. for+-- the purpose of locating the next @{{#if}}@ opener, or an orphan if+-- one occurs first).+splitNextBlock :: Text -> NextBlock+splitNextBlock input = scan 0 input+  where+    scan :: Int -> Text -> NextBlock+    scan pos t+      | T.null t = NoBlockLeft+      | "{{#if " `T.isPrefixOf` t =+          let before = T.take pos input+              afterOpen = T.drop 6 t -- skip "{{#if "+           in case T.breakOn "}}" afterOpen of+                (_, "") -> NoBlockLeft -- malformed; let higher-level handle+                (exprRaw, rest) ->+                  let expr = T.strip exprRaw+                      afterCloseTag = T.drop 2 rest -- skip "}}"+                   in FoundIf+                        { foundBefore = before,+                          foundAfter = afterCloseTag,+                          foundExpr = expr+                        }+      | "{{/if}}" `T.isPrefixOf` t =+          FoundOrphan "{{/if}}" (lineOffset (T.take pos input))+      | "{{#else}}" `T.isPrefixOf` t =+          FoundOrphan "{{#else}}" (lineOffset (T.take pos input))+      | otherwise =+          let headChar = T.take 1 t+              rest = T.drop 1 t+           in scan (pos + T.length headChar) rest++-- | Given the text immediately after an @{{#if …}}@ opener, find the+-- matching @{{\/if}}@ (honouring nested @{{#if}}@\/@{{\/if}}@ pairs) and+-- split the body at a top-level @{{#else}}@ if one is present.+--+-- Returns @(thenBranch, elseBranch, afterCloseBlock, linesConsumedUpToAndIncludingClose, closerSkipped)@.+-- The @openLine@ parameter is the absolute source-line number of the+-- opener, used only when reporting 'UnterminatedIf'.+--+-- Standalone-block trim is applied to the top-level @{{#else}}@ (if+-- present) and to the matching @{{\/if}}@. @closerSkipped@ is 1 when+-- the closer\'s trailing newline was absorbed by standalone trim and+-- 0 otherwise; callers add it to their own post-block line counter+-- so chained blocks at the same level report accurate line numbers.+splitBranches ::+  Int ->+  Text ->+  Either [PlaceholderError] (Text, Text, Text, Int, Int)+splitBranches openLine bodyPlusTail = go 0 0 Nothing bodyPlusTail+  where+    -- depth: how many extra {{#if}} openers we've seen since the outer opener.+    -- accLen: how much of @bodyPlusTail@ we've consumed (character count).+    -- mElseAt: @Just accLen@ at the first top-level {{#else}}, if any.+    go :: Int -> Int -> Maybe Int -> Text -> Either [PlaceholderError] (Text, Text, Text, Int, Int)+    go _ _ _ t+      | T.null t = Left [UnterminatedIf openLine]+    go depth accLen mElseAt t+      | "{{/if}}" `T.isPrefixOf` t && depth == 0 =+          let (thenText0, elseText0) = case mElseAt of+                Nothing -> (T.take accLen bodyPlusTail, "")+                Just elseAt ->+                  ( T.take elseAt bodyPlusTail,+                    T.take (accLen - elseAt - elseTokenLen) (T.drop (elseAt + elseTokenLen) bodyPlusTail)+                  )+              afterClose0 = T.drop (accLen + ifCloseLen) bodyPlusTail+              consumedLines = lineOffset (T.take (accLen + ifCloseLen) bodyPlusTail)+              -- Trim standalone closer: the line's whitespace-before+              -- lives at the tail of whichever branch ended at it+              -- (elseText0 if present, otherwise thenText0), and the+              -- whitespace+newline-after lives at the head of afterClose0.+              (thenText, elseText, afterClose, closerSkipped) =+                case mElseAt of+                  Nothing ->+                    let (tt, ac, n) = trimStandaloneAround thenText0 afterClose0+                     in (tt, "", ac, n)+                  Just _ ->+                    -- First try to trim standalone {{#else}} between+                    -- thenText and elseText, then trim the closer.+                    let (tt, et0, _elseSkipped) = trimStandaloneAround thenText0 elseText0+                        (et, ac, n) = trimStandaloneAround et0 afterClose0+                     in (tt, et, ac, n)+           in Right (thenText, elseText, afterClose, consumedLines, closerSkipped)+      | "{{/if}}" `T.isPrefixOf` t =+          advance (depth - 1) accLen mElseAt t ifCloseLen+      | "{{#if " `T.isPrefixOf` t =+          advance (depth + 1) accLen mElseAt t ifOpenPrefixLen+      | "{{#else}}" `T.isPrefixOf` t && depth == 0 =+          let newElseAt = case mElseAt of+                Just existing -> Just existing+                Nothing -> Just accLen+           in advance depth accLen newElseAt t elseTokenLen+      | "{{#else}}" `T.isPrefixOf` t =+          advance depth accLen mElseAt t elseTokenLen+      | otherwise =+          advance depth accLen mElseAt t 1++    advance ::+      Int ->+      Int ->+      Maybe Int ->+      Text ->+      Int ->+      Either [PlaceholderError] (Text, Text, Text, Int, Int)+    advance depth accLen mElseAt t n =+      let step = T.take n t+          rest = T.drop n t+       in go depth (accLen + T.length step) mElseAt rest++    ifOpenPrefixLen = T.length ("{{#if " :: Text)+    ifCloseLen = T.length ("{{/if}}" :: Text)+    elseTokenLen = T.length ("{{#else}}" :: Text)++-- | Number of newlines in @t@; used to compute line offsets from+-- byte positions.+lineOffset :: Text -> Int+lineOffset = T.count "\n"++-- | Standalone-block trim: if the tag sitting between @before@ and+-- @after@ is the only non-whitespace content on its line, strip the+-- surrounding indentation and the trailing newline. Returns the+-- trimmed pair and the number of newlines the trim absorbed (0 or 1)+-- so the caller can keep source-line tracking accurate.+--+-- A tag qualifies as standalone iff:+--+-- * the tail of @before@ since the last newline (or since the start+--   of @before@ when there is no prior newline) consists only of+--   spaces and tabs, AND+-- * the head of @after@ up to and including the next newline consists+--   only of spaces and tabs followed by a newline — OR @after@ ends+--   before any newline appears and contains only spaces and tabs+--   (i.e. EOF with trailing whitespace).+trimStandaloneAround :: Text -> Text -> (Text, Text, Int)+trimStandaloneAround before after =+  case (stripTailWhitespace before, stripHeadWhitespaceNewline after) of+    (Just b', Just (a', consumed)) -> (b', a', consumed)+    _ -> (before, after, 0)++-- | Strip trailing spaces and tabs at the end of @t@ if the suffix+-- since the last newline (or from the start of @t@) contains only+-- whitespace. Returns 'Nothing' otherwise, so the caller can fall+-- back to the untrimmed text.+stripTailWhitespace :: Text -> Maybe Text+stripTailWhitespace t =+  let (beforeLastLine, lastLine) = T.breakOnEnd "\n" t+   in if T.all isSpaceOrTab lastLine+        then Just beforeLastLine+        else Nothing++-- | Strip leading spaces and tabs at the start of @t@ followed by a+-- single newline. Returns the remainder paired with the number of+-- newlines consumed (always 0 or 1). EOF after trailing whitespace+-- counts as a standalone match with 0 newlines consumed.+stripHeadWhitespaceNewline :: Text -> Maybe (Text, Int)+stripHeadWhitespaceNewline t =+  let (_ws, rest) = T.span isSpaceOrTab t+   in if T.null rest+        then Just ("", 0)+        else case T.uncons rest of+          Just ('\n', after) -> Just (after, 1)+          _ -> Nothing++isSpaceOrTab :: Char -> Bool+isSpaceOrTab c = c == ' ' || c == '\t'
+ src/Seihou/Engine/TypedDhallText.hs view
@@ -0,0 +1,121 @@+-- | Experimental "Prototype B" renderer for the Dhall-as-templating+-- evaluation in @docs/plans/8-evaluate-dhall-as-templating-language.md@.+--+-- Unlike the production 'Seihou.Engine.Plan.compileDhallTextStep',+-- this renderer does __not__ perform Seihou @{{var}}@ placeholder+-- substitution against the raw Dhall source. Instead it treats the+-- source as a typed Dhall function @\(vars : RecordType) -> Text@+-- and applies it to a record literal built from the resolved+-- variable map.+--+-- This module is reachable only from tests — it is intentionally not+-- wired into 'Seihou.Engine.Plan.compileStep' or the 'Strategy' enum.+module Seihou.Engine.TypedDhallText+  ( renderTypedDhallText,+    fieldNameFor,+  )+where++import Control.Exception (SomeException, try)+import Data.Map.Strict qualified as Map+import Data.Text qualified as T+import Data.Text.IO qualified as TIO+import Dhall qualified+import Seihou.Core.Types+import Seihou.Prelude++-- | Render a Dhall source file that exports a+-- @\\(vars : RecordType) -> Text@ function by applying it to a typed+-- record built from the resolved variable map.+--+-- The caller is responsible for building @Map VarName VarValue@ from+-- variable resolution. The returned 'Text' is the evaluated output of+-- the function.+renderTypedDhallText ::+  -- | Path to the @.dhall@ source file.+  FilePath ->+  -- | Resolved variables to pass to the function.+  Map VarName VarValue ->+  IO (Either Text Text)+renderTypedDhallText srcPath vars = do+  sourceResult <- try (TIO.readFile srcPath)+  case sourceResult of+    Left (e :: SomeException) ->+      pure (Left ("failed to read source: " <> T.pack (show e)))+    Right source -> do+      let record = buildRecordLiteral vars+          -- @(\(vars : ...) -> ...) { field1 = ..., ... }@+          applied = "(" <> source <> ") " <> record+      evalResult <- try (Dhall.input Dhall.strictText applied)+      case evalResult of+        Left (e :: SomeException) ->+          pure (Left ("Dhall evaluation failed: " <> T.pack (show e)))+        Right txt -> pure (Right txt)++-- | Build a Dhall record literal expression (as 'Text') from a variable map.+--+-- Field names are derived from variable names by replacing @.@ with @_@+-- via 'fieldNameFor'. Values are emitted with their natural Dhall syntax:+--+--  * 'VText' -> quoted Dhall @Text@ literal with characters escaped.+--  * 'VBool' -> @True@ or @False@.+--  * 'VInt'  -> Dhall @Integer@ literal (with sign prefix).+--  * 'VList' -> Dhall @List@ with element type inferred from the first+--    element. Empty lists fall back to @List Text@.+buildRecordLiteral :: Map VarName VarValue -> Text+buildRecordLiteral vars+  | Map.null vars = "{=}"+  | otherwise =+      "{ "+        <> T.intercalate+          ", "+          [fieldNameFor name <> " = " <> renderVarValue v | (name, v) <- Map.toList vars]+        <> " }"++-- | Deterministic mapping from 'VarName' to a valid Dhall identifier.+-- Replaces @.@ and @-@ with @_@ to produce a bare identifier usable+-- without backtick quoting.+fieldNameFor :: VarName -> Text+fieldNameFor (VarName n) = T.map fixChar n+  where+    fixChar '.' = '_'+    fixChar '-' = '_'+    fixChar c = c++-- | Render a single 'VarValue' as Dhall source.+renderVarValue :: VarValue -> Text+renderVarValue = \case+  VText t -> renderText t+  VBool True -> "True"+  VBool False -> "False"+  VInt n+    | n >= 0 -> "+" <> T.pack (show n)+    | otherwise -> T.pack (show n)+  VList [] -> "[] : List Text"+  VList vs@(v : _) ->+    "[ " <> T.intercalate ", " (map renderVarValue vs) <> " ] : List " <> dhallTypeOf v++-- | Render a text value as a Dhall double-quoted string literal, escaping+-- @\\@, @"@, and the Dhall interpolation trigger @${@.+renderText :: Text -> Text+renderText t =+  "\""+    <> T.concatMap escapeChar t+    <> "\""+  where+    escapeChar '\\' = "\\\\"+    escapeChar '"' = "\\\""+    escapeChar '\n' = "\\n"+    escapeChar '\t' = "\\t"+    escapeChar '\r' = "\\r"+    escapeChar '$' = "\\$" -- Dhall escape for literal '$' so "${" never forms.+    escapeChar c = T.singleton c++-- | Dhall type name for a single 'VarValue', used when emitting a typed+-- empty list or annotating a non-empty list. Nested lists are not+-- supported by this prototype.+dhallTypeOf :: VarValue -> Text+dhallTypeOf (VText _) = "Text"+dhallTypeOf (VBool _) = "Bool"+dhallTypeOf (VInt _) = "Integer"+dhallTypeOf (VList _) = "Text" -- nested-list fallback; flagged in the evaluation doc.
+ src/Seihou/Engine/Validate.hs view
@@ -0,0 +1,371 @@+module Seihou.Engine.Validate+  ( DiagSeverity (..),+    DiagCheck (..),+    ValidateReport (..),+    buildReport,+    renderReportPlain,+    reportHasErrors,+  )+where++import Data.Map.Strict qualified as Map+import Data.Maybe (isNothing, mapMaybe)+import Data.Set qualified as Set+import Data.Text qualified as T+import Data.Text.IO qualified as TIO+import Seihou.Core.Expr (exprRefs, parseExpr)+import Seihou.Core.Module+  ( checkCommandSafety,+    checkDependencyNames,+    checkDestVarRefs,+    checkExportRefs,+    checkFileExistence,+    checkNameFormat,+    checkPromptRefs,+    checkSafeDestinations,+    checkUniqueVars,+    checkVersionPresent,+    extractPlaceholders,+  )+import Seihou.Core.Types+import Seihou.Engine.Template (extractIfExprs)+import Seihou.Prelude+import System.Directory (doesFileExist)++-- | Severity of a diagnostic check result.+data DiagSeverity+  = DiagError+  | DiagWarning+  deriving stock (Eq, Show)++-- | A single diagnostic check with its result.+data DiagCheck = DiagCheck+  { diagLabel :: Text,+    diagSeverity :: DiagSeverity,+    diagDetails :: [Text]+  }+  deriving stock (Eq, Show)++-- | A complete validation report for a module.+data ValidateReport = ValidateReport+  { reportModule :: Module,+    reportPath :: FilePath,+    reportDhallOk :: Bool,+    reportDhallError :: Maybe Text,+    reportChecks :: [DiagCheck]+  }+  deriving stock (Eq, Show)++-- | Build a structured validation report. When the first argument is True,+-- lint warnings are included after the core checks.+buildReport :: Bool -> FilePath -> Module -> IO ValidateReport+buildReport lint baseDir m = do+  fileErrors <- checkFileExistence baseDir m+  -- The conditional lint reads template file contents, so it runs in IO and+  -- only when --lint is requested.+  (undeclaredRefs, typeMismatches) <-+    if lint then lintConditionals baseDir m else pure ([], [])+  let coreChecks =+        [ DiagCheck "Module name format" DiagError (checkNameFormat m),+          DiagCheck "Module version declared" DiagError (checkVersionPresent m),+          DiagCheck "Unique variable names" DiagError (checkUniqueVars m),+          DiagCheck "Prompt references" DiagError (checkPromptRefs m),+          DiagCheck "Export references" DiagError (checkExportRefs m),+          DiagCheck "Source file existence" DiagError fileErrors,+          DiagCheck "Dependency names" DiagError (checkDependencyNames m),+          DiagCheck "Safe step destinations" DiagError (checkSafeDestinations m),+          DiagCheck "Destination variable references" DiagError (checkDestVarRefs m),+          DiagCheck "Command safety" DiagError (checkCommandSafety m)+        ]+      lintChecks =+        if lint+          then+            [ -- Conditional findings are genuine correctness bugs (the class+              -- that silently dropped guarded output), so they gate exit+              -- status as DiagError, while remaining gated behind --lint.+              DiagCheck "Conditional variable references" DiagError undeclaredRefs,+              DiagCheck "Conditional comparison types" DiagError typeMismatches,+              DiagCheck "Unused variables" DiagWarning (lintUnusedVars m),+              DiagCheck "Required variables without prompts" DiagWarning (lintRequiredWithoutPrompt m),+              DiagCheck "Duplicate step destinations" DiagWarning (lintDuplicateDestinations m),+              DiagCheck "Empty choice lists" DiagWarning (lintEmptyChoices m),+              DiagCheck "Missing variable descriptions" DiagWarning (lintMissingDescriptions m)+            ]+          else []+  pure+    ValidateReport+      { reportModule = m,+        reportPath = baseDir,+        reportDhallOk = True,+        reportDhallError = Nothing,+        reportChecks = coreChecks ++ lintChecks+      }++-- | Whether the report contains any errors (DiagError with non-empty details).+reportHasErrors :: ValidateReport -> Bool+reportHasErrors report =+  not report.reportDhallOk+    || any (\c -> c.diagSeverity == DiagError && not (null c.diagDetails)) report.reportChecks++-- | Render the report as plain text (no ANSI codes).+renderReportPlain :: ValidateReport -> Text+renderReportPlain report =+  T.unlines $+    [ "Validating module at " <> T.pack report.reportPath <> "...",+      ""+    ]+      ++ dhallLine+      ++ summaryLines+      ++ checkLines+      ++ [""]+      ++ [resultLine]+  where+    m = report.reportModule++    dhallLine =+      if report.reportDhallOk+        then ["  \x2713 module.dhall evaluates successfully"]+        else+          ["  \x2717 module.dhall failed to evaluate"]+            ++ case report.reportDhallError of+              Just errText -> ["      " <> errText]+              Nothing -> []++    summaryLines =+      if report.reportDhallOk+        then+          [ "  \x2713 Module name: " <> m.name.unModuleName,+            "  \x2713 " <> T.pack (show (length m.vars)) <> " variables declared",+            "  \x2713 " <> T.pack (show (length m.prompts)) <> " prompts defined",+            "  \x2713 " <> T.pack (show (length m.steps)) <> " steps defined"+          ]+        else []++    checkLines = concatMap renderCheck report.reportChecks++    renderCheck c+      | null c.diagDetails =+          ["  \x2713 " <> c.diagLabel]+      | c.diagSeverity == DiagWarning =+          ("  \x26A0 " <> c.diagLabel) : map (\d -> "      " <> d) c.diagDetails+      | otherwise =+          ("  \x2717 " <> c.diagLabel) : map (\d -> "      " <> d) c.diagDetails++    errorCount =+      length+        [ ()+        | c <- report.reportChecks,+          c.diagSeverity == DiagError,+          not (null c.diagDetails)+        ]++    dhallFailed = not report.reportDhallOk++    totalErrors = errorCount + (if dhallFailed then 1 else 0)++    resultLine+      | totalErrors > 0 =+          T.pack (show totalErrors) <> " error(s) found. Module is invalid."+      | otherwise =+          "Module '" <> m.name.unModuleName <> "' is valid."++-- Lint checks++-- | Variables declared but never referenced in step destinations, exports, or prompts.+lintUnusedVars :: Module -> [Text]+lintUnusedVars m =+  let destRefs =+        Set.fromList $+          concatMap (extractPlaceholders . (.dest)) m.steps+      exportRefs =+        Set.fromList $+          map (.var.unVarName) m.exports+      promptRefs =+        Set.fromList $+          map (.var.unVarName) m.prompts+      allRefs = Set.unions [destRefs, exportRefs, promptRefs]+   in mapMaybe+        ( \v ->+            let name' = v.name.unVarName+             in if Set.member name' allRefs+                  then Nothing+                  else Just ("variable '" <> name' <> "' is declared but never referenced")+        )+        m.vars++-- | Required variables that have no corresponding prompt.+lintRequiredWithoutPrompt :: Module -> [Text]+lintRequiredWithoutPrompt m =+  let promptedVars = Set.fromList $ map (.var.unVarName) m.prompts+   in mapMaybe+        ( \v ->+            let name' = v.name.unVarName+             in if v.required && not (Set.member name' promptedVars)+                  then Just ("required variable '" <> name' <> "' has no prompt")+                  else Nothing+        )+        m.vars++-- | Steps that write to the same destination (excluding patch ops).+lintDuplicateDestinations :: Module -> [Text]+lintDuplicateDestinations m =+  let nonPatchDests = [s.dest | s <- m.steps, isNothing s.patch]+      dupes = findDuplicates Set.empty Set.empty nonPatchDests+   in map (\d -> "multiple steps write to '" <> d <> "'") dupes++findDuplicates :: Set.Set Text -> Set.Set Text -> [Text] -> [Text]+findDuplicates _ _ [] = []+findDuplicates seen reported (x : xs)+  | Set.member x seen && not (Set.member x reported) =+      x : findDuplicates seen (Set.insert x reported) xs+  | otherwise = findDuplicates (Set.insert x seen) reported xs++-- | Choice variables with an empty option list.+lintEmptyChoices :: Module -> [Text]+lintEmptyChoices m =+  mapMaybe+    ( \v -> case v.type_ of+        VTChoice [] -> Just ("variable '" <> v.name.unVarName <> "' has an empty choice list")+        _ -> Nothing+    )+    m.vars++-- | Variables without a description.+lintMissingDescriptions :: Module -> [Text]+lintMissingDescriptions m =+  mapMaybe+    ( \v ->+        if isNothing v.description+          then Just ("variable '" <> v.name.unVarName <> "' has no description")+          else Nothing+    )+    m.vars++-- Conditional-expression lint (when clauses + template {{#if}} conditionals)++-- | A finding about a conditional expression, tagged by kind so 'buildReport'+-- can render undeclared-reference and type-mismatch findings under separate+-- check labels.+data CondFinding+  = CondUndeclared Text+  | CondTypeMismatch Text++-- | Lint every conditional expression in the module: step, command, and prompt+-- @when@ clauses (already parsed to 'Expr') plus @{{#if …}}@ conditionals in+-- text-bearing template files. Returns @(undeclaredReferences, typeMismatches)@.+--+-- Each referenced variable is checked against the module's declarations: a+-- reference to an undeclared variable, or an @Eq@ comparison whose literal type+-- cannot match the variable's declared type (e.g. a @bool@ variable compared+-- against the quoted string @"true"@), becomes a finding.+lintConditionals :: FilePath -> Module -> IO ([Text], [Text])+lintConditionals baseDir m = do+  templateExprs <- collectTemplateExprs baseDir m+  let declaredTypes = Map.fromList [(d.name, d.type_) | d <- m.vars]+      stepExprs =+        [("step '" <> s.dest <> "' when clause", c) | s <- m.steps, Just c <- [s.condition]]+      commandExprs =+        [("command when clause", c) | c0 <- m.commands, Just c <- [c0.condition]]+      promptExprs =+        [ ("prompt for '" <> p.var.unVarName <> "' when clause", c)+        | p <- m.prompts,+          Just c <- [p.condition]+        ]+      allExprs = stepExprs ++ commandExprs ++ promptExprs ++ templateExprs+      findings = concatMap (uncurry (lintExpr declaredTypes)) allExprs+  pure+    ( [t | CondUndeclared t <- findings],+      [t | CondTypeMismatch t <- findings]+    )++-- | Read text-bearing template files (@Template@ / @DhallText@ strategies) and+-- extract their @{{#if …}}@ conditionals, parsed to 'Expr'. Files that do not+-- exist are skipped (their absence is already reported by the core+-- source-file-existence check); expressions that fail to parse are skipped here+-- (they surface at render time, outside this lint's scope).+collectTemplateExprs :: FilePath -> Module -> IO [(Text, Expr)]+collectTemplateExprs baseDir m =+  concat <$> mapM readStep textBearingSteps+  where+    textBearingSteps = filter (isTextBearing . (.strategy)) m.steps++    isTextBearing Template = True+    isTextBearing DhallText = True+    isTextBearing _ = False++    readStep s = do+      let path = baseDir </> "files" </> s.src+      exists <- doesFileExist path+      if not exists+        then pure []+        else do+          contents <- TIO.readFile path+          let label = "template '" <> T.pack s.src <> "' {{#if}} condition"+          pure [(label, expr) | raw <- extractIfExprs contents, Right expr <- [parseExpr raw]]++-- | Lint a single expression from the given source against the declared types.+lintExpr :: Map.Map VarName VarType -> Text -> Expr -> [CondFinding]+lintExpr declaredTypes srcLabel expr =+  concatMap checkRef (exprRefs expr)+  where+    checkRef (name, mLit) =+      case Map.lookup name declaredTypes of+        Nothing ->+          [CondUndeclared (srcLabel <> " references undeclared variable: " <> name.unVarName)]+        Just ty -> case mLit of+          Just lit+            | not (literalMatchesType ty lit) ->+                [CondTypeMismatch (describeMismatch srcLabel name ty lit)]+          _ -> []++-- | Whether an @Eq@ literal's constructor can match a value of the declared+-- type. Bool→'VBool', int→'VInt', text→'VText', choice→'VText' (choice values+-- resolve to text), list→'VList'.+literalMatchesType :: VarType -> VarValue -> Bool+literalMatchesType VTBool (VBool _) = True+literalMatchesType VTInt (VInt _) = True+literalMatchesType VTText (VText _) = True+literalMatchesType (VTChoice _) (VText _) = True+literalMatchesType (VTList _) (VList _) = True+literalMatchesType _ _ = False++-- | Build a human-readable message for a type-inconsistent @Eq@ comparison,+-- with an actionable hint where one applies (the original bug: a @bool@+-- variable compared against the quoted string @"true"@ instead of the+-- bareword @true@).+describeMismatch :: Text -> VarName -> VarType -> VarValue -> Text+describeMismatch srcLabel name ty lit =+  srcLabel+    <> " compares variable '"+    <> name.unVarName+    <> "' (declared type "+    <> renderVarType ty+    <> ") against "+    <> describeLiteral lit+    <> "; the comparison can never match."+    <> mismatchHint ty lit++-- | A short hint steering the author to the correct literal form.+mismatchHint :: VarType -> VarValue -> Text+mismatchHint VTBool (VText t)+  | T.toLower (T.strip t) `elem` ["true", "false"] =+      " Use the bareword " <> T.toLower (T.strip t) <> " instead of the quoted \"" <> t <> "\"."+mismatchHint VTInt (VText t) = " Use the unquoted number " <> t <> " instead of the quoted \"" <> t <> "\"."+mismatchHint VTText (VBool b) =+  " Use the quoted string \"" <> (if b then "true" else "false") <> "\" instead of the bareword."+mismatchHint _ _ = ""++-- | Render an @Eq@ literal for a diagnostic message.+describeLiteral :: VarValue -> Text+describeLiteral (VText t) = "string literal \"" <> t <> "\""+describeLiteral (VBool b) = "bareword " <> (if b then "true" else "false")+describeLiteral (VInt n) = "integer literal " <> T.pack (show n)+describeLiteral (VList _) = "a list literal"++-- | A short rendering of a declared variable type for diagnostic messages.+renderVarType :: VarType -> Text+renderVarType VTText = "text"+renderVarType VTBool = "bool"+renderVarType VTInt = "int"+renderVarType (VTList ty) = "list " <> renderVarType ty+renderVarType (VTChoice _) = "choice"
+ src/Seihou/Interaction/Confirm.hs view
@@ -0,0 +1,94 @@+module Seihou.Interaction.Confirm+  ( confirmDefaults,+  )+where++import Control.Monad (foldM)+import Data.Map.Strict qualified as Map+import Seihou.Composition.Instance (ModuleInstance (..))+import Seihou.Core.Types+import Seihou.Effect.Console (Console, isInteractive, putText)+import Seihou.Interaction.Prompt (promptForVar)+import Seihou.Prelude++-- | Walk the resolved variable map and prompt the user to confirm or+-- override each variable whose source is 'FromDefault' or 'FromParent'.+--+-- Variables whose new value matches the original are left unchanged+-- (preserving their original source). Variables whose new value differs+-- are recorded with 'FromPrompt' as their source, so the downstream+-- save-prompted flow picks them up.+--+-- A no-op in non-interactive mode, and a no-op when no variable is+-- resolved from a default.+--+-- Operates per 'ModuleInstance': two invocations of the same module+-- are confirmed independently, so the user can approve different+-- defaults for each.+confirmDefaults ::+  (Console :> es) =>+  [(ModuleInstance, Module, FilePath)] ->+  Map ModuleInstance (Map VarName ResolvedVar) ->+  Eff es (Map ModuleInstance (Map VarName ResolvedVar))+confirmDefaults modulesInOrder resolved = do+  interactive <- isInteractive+  if not interactive || not (anyNeedsConfirm resolved)+    then pure resolved+    else do+      putText ""+      putText "Confirm default values:"+      foldM processInstance resolved modulesInOrder++anyNeedsConfirm :: Map ModuleInstance (Map VarName ResolvedVar) -> Bool+anyNeedsConfirm = any (any isDefaultOrParent) . Map.elems++isDefaultOrParent :: ResolvedVar -> Bool+isDefaultOrParent rv = case rv.source of+  FromDefault -> True+  FromParent _ -> True+  _ -> False++processInstance ::+  (Console :> es) =>+  Map ModuleInstance (Map VarName ResolvedVar) ->+  (ModuleInstance, Module, FilePath) ->+  Eff es (Map ModuleInstance (Map VarName ResolvedVar))+processInstance acc (inst, m, _dir) = do+  let modResolved = Map.findWithDefault Map.empty inst acc+  newModResolved <- foldM (processVar m acc) modResolved m.vars+  pure (Map.insert inst newModResolved acc)++processVar ::+  (Console :> es) =>+  Module ->+  Map ModuleInstance (Map VarName ResolvedVar) ->+  Map VarName ResolvedVar ->+  VarDecl ->+  Eff es (Map VarName ResolvedVar)+processVar m allResolved modResolved decl =+  case Map.lookup decl.name modResolved of+    Just rv | isDefaultOrParent rv -> do+      let prompt = findOrSynthesize m decl+          currentBindings =+            Map.map (.value) (Map.unions (Map.elems allResolved))+      result <- promptForVar prompt decl currentBindings+      case result of+        Left _err -> pure modResolved+        Right newRv+          | newRv.value == rv.value -> pure modResolved+          | otherwise -> pure (Map.insert decl.name newRv modResolved)+    _ -> pure modResolved++-- | Find the authored 'Prompt' for a variable, or build a minimal one+-- from the declaration.+findOrSynthesize :: Module -> VarDecl -> Prompt+findOrSynthesize m decl =+  case filter (\p -> p.var == decl.name) m.prompts of+    (p : _) -> p+    [] ->+      Prompt+        { var = decl.name,+          text = decl.name.unVarName,+          condition = Nothing,+          choices = Nothing+        }
+ src/Seihou/Interaction/Prompt.hs view
@@ -0,0 +1,200 @@+module Seihou.Interaction.Prompt+  ( runPrompts,+    promptForVar,+  )+where++import Data.Map.Strict qualified as Map+import Data.Text qualified as T+import Seihou.Core.Expr (evalExpr)+import Seihou.Core.Types+import Seihou.Core.Variable (coerceValue, validateVarValue)+import Seihou.Effect.Console (Console, getLine, putText)+import Seihou.Prelude+import Prelude hiding (getLine)++-- | Run prompts for unresolved variables.+--+-- For each prompt whose variable is in the unresolved set:+-- 1. Evaluate the prompt's @condition@ against current bindings.+-- 2. If the condition is false, skip.+-- 3. Display the prompt text and read input (or show choice menu).+-- 4. Coerce and validate the input.+-- 5. On failure, retry up to 3 times.+--+-- Returns a map of newly resolved variables with 'FromPrompt' source.+runPrompts ::+  (Console :> es) =>+  [Prompt] ->+  [VarDecl] ->+  Map VarName VarValue ->+  Eff es (Map VarName ResolvedVar)+runPrompts 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++-- | Check if a prompt should be displayed based on its @when@ condition.+shouldPrompt :: Prompt -> Map VarName VarValue -> Bool+shouldPrompt p bindings =+  case p.condition of+    Nothing -> True+    Just expr -> evalExpr bindings expr++-- | Prompt for a single variable value.+-- Displays the prompt text, reads input, coerces to the declared type,+-- and validates. Retries up to 3 times on failure.+promptForVar ::+  (Console :> es) =>+  Prompt ->+  VarDecl ->+  Map VarName VarValue ->+  Eff es (Either VarError ResolvedVar)+promptForVar prompt decl _bindings =+  case prompt.choices of+    Just choices -> promptWithChoices prompt decl choices+    Nothing -> promptFreeText prompt decl 3++-- | Prompt with free text input. Retries up to @maxRetries@ times.+--+-- When the variable has a default value, it is shown in brackets after the+-- prompt text (e.g., @Project version [0.1.0.0]:@). Empty input accepts the+-- default. For optional variables without a default, empty input skips.+promptFreeText ::+  (Console :> es) =>+  Prompt ->+  VarDecl ->+  Int ->+  Eff es (Either VarError ResolvedVar)+promptFreeText prompt decl retriesLeft = do+  putText (formatPromptText prompt decl)+  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+                }+          )+      Nothing+        | not decl.required ->+            -- Optional variable with no default — skip+            pure (Left (MissingRequiredVar decl.name))+        | retriesLeft > 1 -> do+            putText "Value cannot be empty. Please try again."+            promptFreeText prompt decl (retriesLeft - 1)+        | otherwise ->+            pure (Left (MissingRequiredVar decl.name))+    else case coerceAndValidate decl raw of+      Left err ->+        if retriesLeft > 1+          then do+            putText ("Invalid input: " <> formatCoercionError err <> ". Please try again.")+            promptFreeText prompt decl (retriesLeft - 1)+          else pure (Left err)+      Right rv -> pure (Right rv)++-- | Prompt with a numbered choice menu.+promptWithChoices ::+  (Console :> es) =>+  Prompt ->+  VarDecl ->+  [Text] ->+  Eff es (Either VarError ResolvedVar)+promptWithChoices prompt decl choices = do+  putText prompt.text+  mapM_ (\(i, c) -> putText ("  " <> T.pack (show i) <> ") " <> c)) (zip [1 :: Int ..] choices)+  putText "Enter selection number:"+  raw <- getLine+  case reads (T.unpack (T.strip raw)) of+    [(n, "")]+      | n >= 1 && n <= length choices ->+          let chosen = choices !! (n - 1)+           in case coerceAndValidate decl chosen of+                Left err -> pure (Left err)+                Right rv -> pure (Right rv)+    _ -> do+      putText ("Please enter a number between 1 and " <> T.pack (show (length choices)) <> ".")+      -- Retry once+      raw2 <- getLine+      case reads (T.unpack (T.strip raw2)) of+        [(n, "")]+          | n >= 1 && n <= length choices ->+              let chosen = choices !! (n - 1)+               in case coerceAndValidate decl chosen of+                    Left err -> pure (Left err)+                    Right rv -> pure (Right rv)+        _ -> pure (Left (MissingRequiredVar decl.name))++-- | Coerce raw text to the variable's type and validate.+coerceAndValidate :: VarDecl -> Text -> Either VarError ResolvedVar+coerceAndValidate decl raw = do+  val <- coerceValue decl.name decl.type_ raw+  validateVarValue decl val+  pure+    ResolvedVar+      { value = val,+        source = FromPrompt,+        decl = decl+      }++-- | Format a VarError for display during retry prompts.+formatCoercionError :: VarError -> Text+formatCoercionError (CoercionFailed _ ty raw) =+  "cannot convert '" <> raw <> "' to " <> showType ty+formatCoercionError (ValidationFailed _ msg) = msg+formatCoercionError (MissingRequiredVar (VarName n)) = "missing value for " <> n+formatCoercionError (TypeMismatch (VarName n) _ _) = "type mismatch for " <> n++showType :: VarType -> Text+showType VTText = "text"+showType VTBool = "bool"+showType VTInt = "int"+showType (VTList _) = "list"+showType (VTChoice _) = "choice"++-- | Format the prompt text, appending a default value hint in brackets+-- when the variable has one (e.g., @"Project version [0.1.0.0]:"@).+-- For optional variables without a default, appends @[skip]@.+formatPromptText :: Prompt -> VarDecl -> Text+formatPromptText prompt decl =+  case decl.default_ of+    Just defVal -> prompt.text <> " [" <> showDefaultValue defVal <> "]:"+    Nothing+      | not decl.required -> prompt.text <> " [skip]:"+      | otherwise -> prompt.text++-- | Render a VarValue for display in a prompt's default hint.+showDefaultValue :: VarValue -> Text+showDefaultValue (VText t) = t+showDefaultValue (VBool True) = "yes"+showDefaultValue (VBool False) = "no"+showDefaultValue (VInt n) = T.pack (show n)+showDefaultValue (VList vs) = T.intercalate ", " (map showDefaultValue vs)
+ src/Seihou/Manifest/Hash.hs view
@@ -0,0 +1,20 @@+module Seihou.Manifest.Hash+  ( hashContent,+  )+where++import Crypto.Hash.SHA256 qualified as SHA256+import Data.ByteString qualified as BS+import Data.ByteString.Base16 qualified as Base16+import Data.Text.Encoding qualified as TE+import Seihou.Core.Types (SHA256 (..))+import Seihou.Prelude++-- | Compute the SHA256 hash of text content, returning a hex-encoded digest.+-- The text is UTF-8 encoded before hashing.+hashContent :: Text -> SHA256+hashContent t =+  let bytes = TE.encodeUtf8 t+      digest = SHA256.hash bytes+      hex = Base16.encode digest+   in SHA256 (TE.decodeUtf8 hex)
+ src/Seihou/Manifest/Types.hs view
@@ -0,0 +1,294 @@+module Seihou.Manifest.Types+  ( emptyManifest,+    currentManifestVersion,+    manifestToJSON,+    manifestFromJSON,+    writeAppliedBlueprint,+  )+where++import Data.Aeson (FromJSON (..), ToJSON (..), (.:), (.=))+import Data.Aeson qualified as Aeson+import Data.Aeson.Types qualified as Aeson+import Data.ByteString.Lazy qualified as LBS+import Data.Map.Strict qualified as Map+import Data.Text qualified as T+import Data.Time (UTCTime)+import Seihou.Core.Types+import Seihou.Prelude hiding ((.=))++-- | Current manifest schema version.+--+-- Bumped from 1 to 2 when 'AppliedModule' gained the @parentVars@ field+-- (see docs/plans/10-parameterized-dep-multi-instantiation.md). Version-1+-- manifests remain readable because the decoder treats a missing+-- @parentVars@ key as 'emptyParentVars'.+--+-- Bumped from 2 to 3 when 'Manifest' gained the optional @blueprint@+-- field (see docs/plans/32-blueprint-manifest-and-status.md).+-- Schema-2 manifests remain readable because the decoder treats a+-- missing @blueprint@ key as 'Nothing'.+currentManifestVersion :: Int+currentManifestVersion = 3++-- | Create an empty manifest with the given timestamp.+emptyManifest :: UTCTime -> Manifest+emptyManifest now =+  Manifest+    { version = currentManifestVersion,+      genAt = now,+      modules = [],+      vars = Map.empty,+      files = Map.empty,+      recipe = Nothing,+      blueprint = Nothing+    }++-- | Record an applied-blueprint provenance on a manifest, replacing any+-- prior entry. Re-running @seihou agent run@ overwrites the recorded+-- blueprint, mirroring the way 'Manifest.recipe' is overwritten when a+-- recipe is re-applied.+writeAppliedBlueprint :: AppliedBlueprint -> Manifest -> Manifest+writeAppliedBlueprint ab m =+  Manifest+    { version = m.version,+      genAt = m.genAt,+      modules = m.modules,+      vars = m.vars,+      files = m.files,+      recipe = m.recipe,+      blueprint = Just ab+    }++-- | Encode a manifest to JSON bytes.+manifestToJSON :: Manifest -> LBS.ByteString+manifestToJSON = Aeson.encode++-- | Decode a manifest from JSON bytes.+manifestFromJSON :: LBS.ByteString -> Either String Manifest+manifestFromJSON = Aeson.eitherDecode++-- JSON instances++instance ToJSON Manifest where+  toJSON m =+    Aeson.object $+      [ "version" .= m.version,+        "generatedAt" .= m.genAt,+        "modules" .= m.modules,+        "variables" .= varsToJSON m.vars,+        "files" .= filesToJSON m.files+      ]+        ++ maybe [] (\r -> ["recipe" .= r]) m.recipe+        ++ maybe [] (\b -> ["blueprint" .= b]) m.blueprint++instance FromJSON Manifest where+  parseJSON = Aeson.withObject "Manifest" $ \o -> do+    v <- o .: "version"+    if v > currentManifestVersion+      then fail "manifest was created by a newer version of seihou"+      else+        Manifest v+          <$> o .: "generatedAt"+          <*> o .: "modules"+          <*> (varsFromJSON =<< o .: "variables")+          <*> (filesFromJSON =<< o .: "files")+          <*> o Aeson..:? "recipe"+          <*> o Aeson..:? "blueprint"++instance ToJSON AppliedRecipe where+  toJSON ar =+    Aeson.object $+      [ "name" .= ar.name.unRecipeName,+        "appliedAt" .= ar.appliedAt+      ]+        ++ maybe [] (\v -> ["version" .= v]) ar.recipeVersion++instance FromJSON AppliedRecipe where+  parseJSON = Aeson.withObject "AppliedRecipe" $ \o ->+    AppliedRecipe+      <$> (RecipeName <$> o .: "name")+      <*> o Aeson..:? "version"+      <*> o .: "appliedAt"++instance ToJSON AppliedBlueprint where+  toJSON ab =+    Aeson.object $+      [ "name" .= ab.name.unModuleName,+        "appliedAt" .= ab.appliedAt,+        "baselineModules" .= map (.unModuleName) ab.baselineModules,+        "noBaseline" .= ab.noBaseline+      ]+        ++ maybe [] (\v -> ["version" .= v]) ab.blueprintVersion+        ++ maybe [] (\p -> ["userPrompt" .= p]) ab.userPrompt+        ++ maybe [] (\s -> ["agentSessionId" .= s]) ab.agentSessionId++instance FromJSON AppliedBlueprint where+  parseJSON = Aeson.withObject "AppliedBlueprint" $ \o ->+    AppliedBlueprint+      <$> (ModuleName <$> o .: "name")+      <*> o Aeson..:? "version"+      <*> o .: "appliedAt"+      <*> (map ModuleName <$> o Aeson..:? "baselineModules" Aeson..!= [])+      <*> o Aeson..:? "noBaseline" Aeson..!= False+      <*> o Aeson..:? "userPrompt"+      <*> o Aeson..:? "agentSessionId"++instance ToJSON AppliedModule where+  toJSON am =+    Aeson.object $+      [ "name" .= am.name.unModuleName,+        "source" .= am.source,+        "appliedAt" .= am.appliedAt+      ]+        ++ parentVarsField am.parentVars+        ++ maybe [] (\v -> ["version" .= v]) am.moduleVersion+        ++ maybe [] (\r -> ["removal" .= removalToJSON r]) am.removal+    where+      parentVarsField (ParentVars m)+        | Map.null m = []+        | otherwise = ["parentVars" .= parentVarsMapToJSON m]++instance FromJSON AppliedModule where+  parseJSON = Aeson.withObject "AppliedModule" $ \o -> do+    -- Backwards compatibility: old manifests have "removable" :: Bool.+    -- "removable": true -> Just (Removal [] [])+    -- "removable": false or absent, and no "removal" -> Nothing+    mRemoval <- o Aeson..:? "removal"+    removal <- case mRemoval of+      Just v -> Just <$> parseRemovalJSON v+      Nothing -> do+        oldRemovable <- o Aeson..:? "removable" Aeson..!= False+        pure (if oldRemovable then Just (Removal [] []) else Nothing)+    -- Schema v1 manifests omit parentVars entirely; decode those as empty.+    mParentVars <- o Aeson..:? "parentVars"+    pv <- case mParentVars of+      Nothing -> pure emptyParentVars+      Just v -> ParentVars <$> parentVarsMapFromJSON v+    AppliedModule+      <$> (ModuleName <$> o .: "name")+      <*> pure pv+      <*> o .: "source"+      <*> o Aeson..:? "version"+      <*> o .: "appliedAt"+      <*> pure removal++parentVarsMapToJSON :: Map VarName Text -> Aeson.Value+parentVarsMapToJSON = toJSON . Map.mapKeys (.unVarName)++parentVarsMapFromJSON :: Aeson.Value -> Aeson.Parser (Map VarName Text)+parentVarsMapFromJSON v = do+  m <- parseJSON v :: Aeson.Parser (Map Text Text)+  pure (Map.mapKeys VarName m)++-- | Encode a Removal to JSON.+removalToJSON :: Removal -> Aeson.Value+removalToJSON r =+  Aeson.object+    [ "steps" .= map removalStepToJSON r.removalSteps,+      "commands" .= map removalCommandToJSON r.removalCommands+    ]++removalStepToJSON :: RemovalStep -> Aeson.Value+removalStepToJSON s =+  Aeson.object $+    [ "action" .= removalActionToText s.action,+      "dest" .= s.dest+    ]+      ++ maybe [] (\p -> ["src" .= p]) s.src++removalActionToText :: RemovalAction -> Text+removalActionToText RemoveFileAction = "remove-file"+removalActionToText RemoveSectionAction = "remove-section"+removalActionToText RewriteFileAction = "rewrite-file"++removalCommandToJSON :: Command -> Aeson.Value+removalCommandToJSON c =+  Aeson.object $+    ["run" .= c.run]+      ++ maybe [] (\w -> ["workDir" .= w]) c.workDir++-- | Parse a Removal from JSON.+parseRemovalJSON :: Aeson.Value -> Aeson.Parser Removal+parseRemovalJSON = Aeson.withObject "Removal" $ \o ->+  Removal+    <$> (o Aeson..:? "steps" Aeson..!= [] >>= mapM parseRemovalStepJSON)+    <*> (o Aeson..:? "commands" Aeson..!= [] >>= mapM parseRemovalCommandJSON)++parseRemovalStepJSON :: Aeson.Value -> Aeson.Parser RemovalStep+parseRemovalStepJSON = Aeson.withObject "RemovalStep" $ \o ->+  RemovalStep+    <$> (parseRemovalActionText =<< o .: "action")+    <*> o .: "dest"+    <*> o Aeson..:? "src"++parseRemovalActionText :: Text -> Aeson.Parser RemovalAction+parseRemovalActionText "remove-file" = pure RemoveFileAction+parseRemovalActionText "remove-section" = pure RemoveSectionAction+parseRemovalActionText "rewrite-file" = pure RewriteFileAction+parseRemovalActionText other = fail ("unknown removal action: " <> T.unpack other)++parseRemovalCommandJSON :: Aeson.Value -> Aeson.Parser Command+parseRemovalCommandJSON = Aeson.withObject "RemovalCommand" $ \o ->+  Command+    <$> o .: "run"+    <*> o Aeson..:? "workDir"+    <*> pure Nothing++instance ToJSON FileRecord where+  toJSON fr =+    Aeson.object+      [ "hash" .= fr.hash.unSHA256,+        "module" .= fr.moduleName.unModuleName,+        "strategy" .= strategyToText fr.strategy,+        "generatedAt" .= fr.generatedAt+      ]++instance FromJSON FileRecord where+  parseJSON = Aeson.withObject "FileRecord" $ \o ->+    FileRecord+      <$> (SHA256 <$> o .: "hash")+      <*> (ModuleName <$> o .: "module")+      <*> (strategyFromText =<< o .: "strategy")+      <*> o .: "generatedAt"++instance ToJSON SHA256 where+  toJSON (SHA256 t) = toJSON t++instance FromJSON SHA256 where+  parseJSON v = SHA256 <$> parseJSON v++-- Helpers for VarName-keyed maps++varsToJSON :: Map VarName Text -> Aeson.Value+varsToJSON = toJSON . Map.mapKeys (.unVarName)++varsFromJSON :: Aeson.Value -> Aeson.Parser (Map VarName Text)+varsFromJSON v = do+  m <- parseJSON v :: Aeson.Parser (Map Text Text)+  pure (Map.mapKeys VarName m)++-- Helpers for FilePath-keyed maps++filesToJSON :: Map FilePath FileRecord -> Aeson.Value+filesToJSON = toJSON . Map.mapKeys T.pack++filesFromJSON :: Aeson.Value -> Aeson.Parser (Map FilePath FileRecord)+filesFromJSON v = do+  m <- parseJSON v :: Aeson.Parser (Map Text FileRecord)+  pure (Map.mapKeys T.unpack m)++-- Strategy serialization++strategyToText :: Strategy -> Text+strategyToText Copy = "copy"+strategyToText Template = "template"+strategyToText DhallText = "dhall-text"+strategyToText Structured = "structured"++strategyFromText :: Text -> Aeson.Parser Strategy+strategyFromText "copy" = pure Copy+strategyFromText "template" = pure Template+strategyFromText "dhall-text" = pure DhallText+strategyFromText "structured" = pure Structured+strategyFromText other = fail ("unknown strategy: " <> T.unpack other)
+ src/Seihou/Prelude.hs view
@@ -0,0 +1,60 @@+{-# LANGUAGE PackageImports #-}++module Seihou.Prelude+  ( -- * Text+    Text,++    -- * Containers+    Map,+    Set,++    -- * Effectful core+    Eff,+    runEff,+    type (:>),+    type (:>>),+    IOE,+    Effect,+    Dispatch (Dynamic),+    type DispatchOf,+    MonadIO,+    liftIO,++    -- * Effectful dynamic dispatch+    send,+    interpret,+    reinterpret,+    HasCallStack,+    EffectHandler,++    -- * Lens+    view,+    over,+    set,+    (^.),+    (.~),+    (%~),+    (&),+    lens,+    Lens',+    Getting,+    ASetter,++    -- * Bifunctor+    first,++    -- * FilePath+    FilePath,+    (</>),+  )+where++import "base" Data.Bifunctor (first)+import "containers" Data.Map.Strict (Map)+import "containers" Data.Set (Set)+import "effectful-core" Effectful (Dispatch (Dynamic), DispatchOf, Eff, Effect, IOE, MonadIO, liftIO, runEff, type (:>), type (:>>))+import "effectful-core" Effectful.Dispatch.Dynamic (EffectHandler, HasCallStack, interpret, reinterpret, send)+import "filepath" System.FilePath ((</>))+import "generic-lens" Data.Generics.Labels ()+import "lens" Control.Lens (ASetter, Getting, Lens', lens, over, set, view, (%~), (&), (.~), (^.))+import "text" Data.Text (Text)
+ test/Main.hs view
@@ -0,0 +1,113 @@+module Main (main) where++import Seihou.Composition.GraphSpec qualified as GraphSpec+import Seihou.Composition.InstanceSpec qualified as InstanceSpec+import Seihou.Composition.PlanSpec qualified as CompositionPlanSpec+import Seihou.Composition.RecipeSpec qualified as CompositionRecipeSpec+import Seihou.Composition.ResolveSpec qualified as ResolveSpec+import Seihou.Core.AgentPromptSpec qualified as AgentPromptSpec+import Seihou.Core.BlueprintSpec qualified as BlueprintSpec+import Seihou.Core.CommandVarSpec qualified as CommandVarSpec+import Seihou.Core.ContextSpec qualified as ContextSpec+import Seihou.Core.ExprSpec qualified as ExprSpec+import Seihou.Core.InstallSpec qualified as InstallSpec+import Seihou.Core.ListSpec qualified as ListSpec+import Seihou.Core.MigrationSpec qualified as MigrationSpec+import Seihou.Core.ModuleSpec qualified as ModuleSpec+import Seihou.Core.RecipeSpec qualified as RecipeSpec+import Seihou.Core.RegistryEmitSpec qualified as RegistryEmitSpec+import Seihou.Core.RegistrySpec qualified as RegistrySpec+import Seihou.Core.RegistrySyncSpec qualified as RegistrySyncSpec+import Seihou.Core.ScaffoldSpec qualified as ScaffoldSpec+import Seihou.Core.SchemaUpgradeSpec qualified as SchemaUpgradeSpec+import Seihou.Core.StatusSpec qualified as StatusSpec+import Seihou.Core.TypesSpec qualified as TypesSpec+import Seihou.Core.VariableSpec qualified as VariableSpec+import Seihou.Core.VersionSpec qualified as VersionSpec+import Seihou.Dhall.ConfigSpec qualified as ConfigSpec+import Seihou.Dhall.EvalSpec qualified as DhallEvalSpec+import Seihou.Dhall.MigrationDecoderSpec qualified as MigrationDecoderSpec+import Seihou.Effect.ConfigReaderSpec qualified as ConfigReaderSpec+import Seihou.Effect.ConfigWriterSpec qualified as ConfigWriterSpec+import Seihou.Effect.FilesystemSpec qualified as FilesystemSpec+import Seihou.Effect.LoggerSpec qualified as LoggerSpec+import Seihou.Effect.ManifestStoreSpec qualified as ManifestStoreSpec+import Seihou.Engine.ConflictSpec qualified as ConflictSpec+import Seihou.Engine.DiffSpec qualified as DiffSpec+import Seihou.Engine.ExecuteSpec qualified as ExecuteSpec+import Seihou.Engine.MigrateSpec qualified as EngineMigrateSpec+import Seihou.Engine.PlanSpec qualified as PlanSpec+import Seihou.Engine.PreviewSpec qualified as PreviewSpec+import Seihou.Engine.RemoveSpec qualified as RemoveSpec+import Seihou.Engine.SectionSpec qualified as SectionSpec+import Seihou.Engine.TemplateSpec qualified as TemplateSpec+import Seihou.Engine.ValidateSpec qualified as ValidateSpec+import Seihou.Evaluation.ConditionalTemplateSpec qualified as ConditionalTemplateSpec+import Seihou.Evaluation.DhallTextFlakeSpec qualified as DhallTextFlakeSpec+import Seihou.Evaluation.SplitFlakeSpec qualified as SplitFlakeSpec+import Seihou.Evaluation.TypedDhallTextSpec qualified as TypedDhallTextSpec+import Seihou.Integration.CompositionSpec qualified as CompositionSpec+import Seihou.Integration.ExecutionSpec qualified as ExecutionSpec+import Seihou.Integration.GenerationSpec qualified as GenerationSpec+import Seihou.Integration.ModuleLoadSpec qualified as IntegrationSpec+import Seihou.Interaction.ConfirmSpec qualified as ConfirmSpec+import Seihou.Interaction.PromptSpec qualified as PromptSpec+import Seihou.Manifest.TypesSpec qualified as ManifestTypesSpec+import Test.Tasty++main :: IO ()+main = do+  graphTests <- GraphSpec.tests+  instanceTests <- InstanceSpec.tests+  compositionPlanTests <- CompositionPlanSpec.tests+  compositionRecipeTests <- CompositionRecipeSpec.tests+  resolveTests <- ResolveSpec.tests+  agentPromptTests <- AgentPromptSpec.tests+  blueprintTests <- BlueprintSpec.tests+  commandVarTests <- CommandVarSpec.tests+  typesTests <- TypesSpec.tests+  contextTests <- ContextSpec.tests+  exprTests <- ExprSpec.tests+  installTests <- InstallSpec.tests+  listTests <- ListSpec.tests+  migrationTests <- MigrationSpec.tests+  moduleTests <- ModuleSpec.tests+  recipeTests <- RecipeSpec.tests+  registryTests <- RegistrySpec.tests+  registryEmitTests <- RegistryEmitSpec.tests+  registrySyncTests <- RegistrySyncSpec.tests+  scaffoldTests <- ScaffoldSpec.tests+  schemaUpgradeTests <- SchemaUpgradeSpec.tests+  statusTests <- StatusSpec.tests+  variableTests <- VariableSpec.tests+  versionTests <- VersionSpec.tests+  templateTests <- TemplateSpec.tests+  planTests <- PlanSpec.tests+  previewTests <- PreviewSpec.tests+  sectionTests <- SectionSpec.tests+  validateTests <- ValidateSpec.tests+  splitFlakeTests <- SplitFlakeSpec.tests+  dhallTextFlakeTests <- DhallTextFlakeSpec.tests+  typedDhallTextTests <- TypedDhallTextSpec.tests+  conditionalTemplateTests <- ConditionalTemplateSpec.tests+  configTests <- ConfigSpec.tests+  dhallEvalTests <- DhallEvalSpec.tests+  migrationDecoderTests <- MigrationDecoderSpec.tests+  configReaderTests <- ConfigReaderSpec.tests+  configWriterTests <- ConfigWriterSpec.tests+  filesystemTests <- FilesystemSpec.tests+  loggerTests <- LoggerSpec.tests+  manifestStoreTests <- ManifestStoreSpec.tests+  conflictTests <- ConflictSpec.tests+  diffTests <- DiffSpec.tests+  executeTests <- ExecuteSpec.tests+  engineMigrateTests <- EngineMigrateSpec.tests+  removeTests <- RemoveSpec.tests+  compositionTests <- CompositionSpec.tests+  executionTests <- ExecutionSpec.tests+  integrationTests <- IntegrationSpec.tests+  generationTests <- GenerationSpec.tests+  manifestTypesTests <- ManifestTypesSpec.tests+  promptTests <- PromptSpec.tests+  confirmTests <- ConfirmSpec.tests+  defaultMain (testGroup "seihou-core" [graphTests, instanceTests, compositionPlanTests, compositionRecipeTests, resolveTests, agentPromptTests, blueprintTests, commandVarTests, typesTests, contextTests, exprTests, installTests, listTests, migrationTests, moduleTests, recipeTests, registryTests, registryEmitTests, registrySyncTests, scaffoldTests, schemaUpgradeTests, statusTests, variableTests, versionTests, templateTests, planTests, previewTests, sectionTests, validateTests, splitFlakeTests, dhallTextFlakeTests, typedDhallTextTests, conditionalTemplateTests, configTests, dhallEvalTests, migrationDecoderTests, configReaderTests, configWriterTests, filesystemTests, loggerTests, manifestStoreTests, conflictTests, diffTests, executeTests, engineMigrateTests, removeTests, compositionTests, executionTests, integrationTests, generationTests, manifestTypesTests, promptTests, confirmTests])
+ test/Seihou/Composition/GraphSpec.hs view
@@ -0,0 +1,194 @@+module Seihou.Composition.GraphSpec (tests) where++import Data.Either (isLeft)+import Data.Map.Strict qualified as Map+import Seihou.Composition.Graph+import Seihou.Composition.Instance (ModuleInstance (..), mkInstance, primaryInstance)+import Seihou.Core.Types+import Test.Hspec+import Test.Tasty+import Test.Tasty.Hspec (testSpec)++tests :: IO TestTree+tests = testSpec "Seihou.Composition.Graph" spec++-- | Helper to create a minimal module with given name and dependencies.+mkModule :: ModuleName -> [ModuleName] -> Module+mkModule name deps =+  Module+    { name = name,+      version = Nothing,+      description = Nothing,+      vars = [],+      exports = [],+      prompts = [],+      steps = [],+      commands = [],+      dependencies = map simpleDep deps,+      removal = Nothing,+      migrations = []+    }++-- | Helper to build a graph from a list of modules, wrapping each in a+-- primary 'ModuleInstance' (no parent bindings). Works for all the+-- bare-name test scenarios below.+fromModules :: [Module] -> CompositionGraph+fromModules ms = buildGraph [(primaryInstance m.name, m) | m <- ms]++spec :: Spec+spec = do+  describe "buildGraph" $ do+    it "builds a graph from a single module with no dependencies" $ do+      let m = mkModule "base" []+          g = fromModules [m]+      length g.cgModules `shouldBe` 1+      length g.cgEdges `shouldBe` 1++    it "builds a graph preserving dependency edges" $ do+      let a = mkModule "a" ["b", "c"]+          b = mkModule "b" []+          c = mkModule "c" []+          g = fromModules [a, b, c]+      length g.cgModules `shouldBe` 3+      length g.cgEdges `shouldBe` 3++  describe "topoSort" $ do+    it "returns a single module with no dependencies" $ do+      let g = fromModules [mkModule "base" []]+      fmap (map (.instanceModule)) (topoSort g) `shouldBe` Right ["base"]++    it "orders a linear chain: A -> B -> C" $ do+      let a = mkModule "a" ["b"]+          b = mkModule "b" ["c"]+          c = mkModule "c" []+          g = fromModules [a, b, c]+      case topoSort g of+        Right order -> do+          let names = map (.instanceModule) order+          indexOf "c" names `shouldSatisfy` (< indexOf "b" names)+          indexOf "b" names `shouldSatisfy` (< indexOf "a" names)+        Left err -> expectationFailure $ "Expected Right, got: " ++ show err++    it "handles a diamond: A -> [B,C], B -> D, C -> D" $ do+      let a = mkModule "a" ["b", "c"]+          b = mkModule "b" ["d"]+          c = mkModule "c" ["d"]+          d = mkModule "d" []+          g = fromModules [a, b, c, d]+      case topoSort g of+        Right order -> do+          let names = map (.instanceModule) order+          length names `shouldBe` 4+          indexOf "d" names `shouldSatisfy` (< indexOf "b" names)+          indexOf "d" names `shouldSatisfy` (< indexOf "c" names)+          indexOf "b" names `shouldSatisfy` (< indexOf "a" names)+          indexOf "c" names `shouldSatisfy` (< indexOf "a" names)+        Left err -> expectationFailure $ "Expected Right, got: " ++ show err++    it "detects a self-loop" $ do+      let a = mkModule "a" ["a"]+          g = fromModules [a]+      topoSort g `shouldSatisfy` isLeft++    it "detects a cycle: A -> B -> C -> A" $ do+      let a = mkModule "a" ["b"]+          b = mkModule "b" ["c"]+          c = mkModule "c" ["a"]+          g = fromModules [a, b, c]+      topoSort g `shouldSatisfy` isLeft++    it "handles disconnected components" $ do+      let a = mkModule "a" []+          b = mkModule "b" []+          c = mkModule "c" []+          g = fromModules [a, b, c]+      case topoSort g of+        Right order -> length order `shouldBe` 3+        Left err -> expectationFailure $ "Expected Right, got: " ++ show err++    it "handles a larger graph with multiple dependencies" $ do+      let e = mkModule "e" []+          d = mkModule "d" ["e"]+          c = mkModule "c" ["e"]+          b = mkModule "b" ["c", "d"]+          a = mkModule "a" ["b"]+          g = fromModules [a, b, c, d, e]+      case topoSort g of+        Right order -> do+          let names = map (.instanceModule) order+          length names `shouldBe` 5+          indexOf "e" names `shouldSatisfy` (< indexOf "d" names)+          indexOf "e" names `shouldSatisfy` (< indexOf "c" names)+          indexOf "c" names `shouldSatisfy` (< indexOf "b" names)+          indexOf "d" names `shouldSatisfy` (< indexOf "b" names)+          indexOf "b" names `shouldSatisfy` (< indexOf "a" names)+        Left err -> expectationFailure $ "Expected Right, got: " ++ show err++  describe "multi-instantiation" $ do+    it "treats two dependency edges with different depVars as distinct instances" $ do+      let helper = mkModule "helper" []+          -- Parent depends on 'helper' twice with different bindings.+          parent' =+            Module+              { name = "parent",+                version = Nothing,+                description = Nothing,+                vars = [],+                exports = [],+                prompts = [],+                steps = [],+                commands = [],+                dependencies =+                  [ Dependency "helper" (Map.singleton "skill.name" "exec-plan"),+                    Dependency "helper" (Map.singleton "skill.name" "master-plan")+                  ],+                removal = Nothing,+                migrations = []+              }+          parentInst = primaryInstance "parent"+          helperA = mkInstance "helper" (ParentVars (Map.singleton "skill.name" "exec-plan"))+          helperB = mkInstance "helper" (ParentVars (Map.singleton "skill.name" "master-plan"))+          g = buildGraph [(parentInst, parent'), (helperA, helper), (helperB, helper)]+      case topoSort g of+        Right order -> do+          length order `shouldBe` 3+          helperA `elem` order `shouldBe` True+          helperB `elem` order `shouldBe` True+          parentInst `elem` order `shouldBe` True+          -- Both helper invocations must precede the parent.+          let idx x = length (takeWhile (/= x) order)+          idx helperA `shouldSatisfy` (< idx parentInst)+          idx helperB `shouldSatisfy` (< idx parentInst)+        Left err -> expectationFailure $ "Expected Right, got: " ++ show err++    it "dedupes two identical dependency edges into one instance" $ do+      let child = mkModule "child" []+          parent' =+            Module+              { name = "parent",+                version = Nothing,+                description = Nothing,+                vars = [],+                exports = [],+                prompts = [],+                steps = [],+                commands = [],+                dependencies =+                  [ Dependency "child" (Map.singleton "x" "1"),+                    Dependency "child" (Map.singleton "x" "1")+                  ],+                removal = Nothing,+                migrations = []+              }+          parentInst = primaryInstance "parent"+          childInst = mkInstance "child" (ParentVars (Map.singleton "x" "1"))+          g = buildGraph [(parentInst, parent'), (childInst, child)]+      case topoSort g of+        Right order -> length order `shouldBe` 2+        Left err -> expectationFailure $ "Expected Right, got: " ++ show err++-- | Get the index of a ModuleName in a list, or fail.+indexOf :: ModuleName -> [ModuleName] -> Int+indexOf name xs = case lookup name (zip xs [0 ..]) of+  Just i -> i+  Nothing -> error $ "Module not found in order: " ++ show name
+ test/Seihou/Composition/InstanceSpec.hs view
@@ -0,0 +1,56 @@+module Seihou.Composition.InstanceSpec (tests) where++import Data.Map.Strict qualified as Map+import Data.Text qualified as T+import Seihou.Composition.Instance+import Seihou.Core.Types+import Test.Hspec+import Test.Tasty+import Test.Tasty.Hspec (testSpec)++tests :: IO TestTree+tests = testSpec "Seihou.Composition.Instance" spec++spec :: Spec+spec = do+  describe "qualifiedName" $ do+    it "returns the plain module name when no parent bindings are present" $ do+      qualifiedName (primaryInstance "claude-skill-link")+        `shouldBe` ModuleName "claude-skill-link"++    it "appends a stable hash suffix when parent bindings are present" $ do+      let inst = mkInstance "claude-skill-link" (ParentVars (Map.singleton "skill.name" "exec-plan"))+          qn = qualifiedName inst+      T.isPrefixOf "claude-skill-link#" (qn.unModuleName) `shouldBe` True+      T.length (qn.unModuleName) `shouldBe` T.length "claude-skill-link#" + 8++    it "produces a distinct qualified name for each distinct binding" $ do+      let a = mkInstance "claude-skill-link" (ParentVars (Map.singleton "skill.name" "exec-plan"))+          b = mkInstance "claude-skill-link" (ParentVars (Map.singleton "skill.name" "master-plan"))+      qualifiedName a `shouldNotBe` qualifiedName b++    it "is stable across equal but differently constructed binding maps" $ do+      let vs1 = Map.fromList [("a", "1"), ("b", "2")]+          vs2 = Map.fromList [("b", "2"), ("a", "1")]+          ia = mkInstance "m" (ParentVars vs1)+          ib = mkInstance "m" (ParentVars vs2)+      qualifiedName ia `shouldBe` qualifiedName ib++  describe "stableHash" $ do+    it "returns 8 hex characters for any binding set" $ do+      let h = stableHash (ParentVars (Map.singleton "x" "1"))+      T.length h `shouldBe` 8++    it "ignores construction order" $ do+      stableHash (ParentVars (Map.fromList [("a", "1"), ("b", "2")]))+        `shouldBe` stableHash (ParentVars (Map.fromList [("b", "2"), ("a", "1")]))++    it "differs when binding values differ" $ do+      stableHash (ParentVars (Map.singleton "skill.name" "exec-plan"))+        `shouldNotBe` stableHash (ParentVars (Map.singleton "skill.name" "master-plan"))++  describe "ParentVars Eq/Ord" $ do+    it "two ParentVars with identical maps compare equal" $ do+      let a = ParentVars (Map.fromList [("a", "1"), ("b", "2")])+          b = ParentVars (Map.fromList [("b", "2"), ("a", "1")])+      a `shouldBe` b
+ test/Seihou/Composition/PlanSpec.hs view
@@ -0,0 +1,249 @@+module Seihou.Composition.PlanSpec (tests) where++import Data.Text qualified as T+import Seihou.Composition.Plan+import Seihou.Core.Types+import Test.Hspec+import Test.Tasty+import Test.Tasty.Hspec (testSpec)++tests :: IO TestTree+tests = testSpec "Seihou.Composition.Plan" spec++spec :: Spec+spec = do+  describe "mergeOperations" $ do+    it "preserves all operations when no files overlap" $ do+      let aOps = [CreateDirOp "src", WriteFileOp "src/A.hs" "module A" Template]+          bOps = [CreateDirOp "lib", WriteFileOp "lib/B.hs" "module B" Template]+          (ops, warnings, _) = mergeOperations [("mod-a", aOps), ("mod-b", bOps)]+      length ops `shouldBe` 4+      warnings `shouldBe` []++    it "last-writer-wins when two modules write same file" $ do+      let aOps = [WriteFileOp "README.md" "from A" Template]+          bOps = [WriteFileOp "README.md" "from B" Template]+          (ops, warnings, _) = mergeOperations [("mod-a", aOps), ("mod-b", bOps)]+      -- Only B's version should remain+      length (filter isWriteOp ops) `shouldBe` 1+      case filter isWriteOp ops of+        [WriteFileOp _ content _] -> content `shouldBe` "from B"+        _ -> expectationFailure "Expected exactly one WriteFileOp"+      -- Warning should indicate A was overwritten by B+      length warnings `shouldBe` 1+      case warnings of+        [FileOverwritten path overwritten overwriter] -> do+          path `shouldBe` "README.md"+          overwritten `shouldBe` "mod-a"+          overwriter `shouldBe` "mod-b"+        _ -> expectationFailure "Expected one FileOverwritten warning"++    it "deduplicates CreateDirOp silently" $ do+      let aOps = [CreateDirOp "src"]+          bOps = [CreateDirOp "src"]+          (ops, warnings, _) = mergeOperations [("mod-a", aOps), ("mod-b", bOps)]+      length ops `shouldBe` 1+      warnings `shouldBe` []++    it "keeps all RunCommandOp operations" $ do+      let aOps = [RunCommandOp "echo hello" Nothing]+          bOps = [RunCommandOp "echo world" Nothing]+          (ops, warnings, _) = mergeOperations [("mod-a", aOps), ("mod-b", bOps)]+      length ops `shouldBe` 2+      warnings `shouldBe` []++    it "handles CopyFileOp overlapping with WriteFileOp" $ do+      let aOps = [WriteFileOp "config.yaml" "generated" Template]+          bOps = [CopyFileOp "files/config.yaml" "config.yaml"]+          (ops, warnings, _) = mergeOperations [("mod-a", aOps), ("mod-b", bOps)]+      length warnings `shouldBe` 1+      -- B's CopyFileOp should be the winner+      case filter (\op -> destOfOp' op == Just "config.yaml") ops of+        [CopyFileOp {}] -> pure ()+        other -> expectationFailure $ "Expected CopyFileOp, got: " ++ show other++    it "handles three modules with cascading overwrites" $ do+      let aOps = [WriteFileOp "README.md" "from A" Template]+          bOps = [WriteFileOp "README.md" "from B" Template]+          cOps = [WriteFileOp "README.md" "from C" Template]+          (ops, warnings, _) = mergeOperations [("a", aOps), ("b", bOps), ("c", cOps)]+      -- Only C's version should remain+      case filter isWriteOp ops of+        [WriteFileOp _ content _] -> content `shouldBe` "from C"+        _ -> expectationFailure "Expected exactly one WriteFileOp"+      -- Two warnings: A overwritten by B, B overwritten by C+      length warnings `shouldBe` 2++    it "handles empty module operations" $ do+      let (ops, warnings, _) = mergeOperations [("a", []), ("b", [])]+      ops `shouldBe` []+      warnings `shouldBe` []++  describe "mergeOperations (text patching)" $ do+    it "PatchFileOp AppendFile merges with existing WriteFileOp" $ do+      let aOps = [WriteFileOp "README.md" "# Title\n" Template]+          bOps = [PatchFileOp "README.md" "extra line\n" AppendFile Template "mod-b"]+          (ops, warnings, _) = mergeOperations [("mod-a", aOps), ("mod-b", bOps)]+      -- Should be a single merged WriteFileOp+      case filter isWriteOp ops of+        [WriteFileOp _ content _] -> do+          T.isInfixOf "# Title" content `shouldBe` True+          T.isInfixOf "extra line" content `shouldBe` True+        other -> expectationFailure $ "Expected one WriteFileOp, got: " ++ show other+      -- Should produce ContentMerged warning, not FileOverwritten+      case filter isContentMerged warnings of+        [ContentMerged path base contributor] -> do+          path `shouldBe` "README.md"+          base `shouldBe` "mod-a"+          contributor `shouldBe` "mod-b"+        other -> expectationFailure $ "Expected one ContentMerged, got: " ++ show other++    it "PatchFileOp AppendSection adds section markers and merges" $ do+      let aOps = [WriteFileOp "README.md" "# Title\n" Template]+          bOps = [PatchFileOp "README.md" "section content\n" AppendSection Template "mod-b"]+          (ops, _, _) = mergeOperations [("mod-a", aOps), ("mod-b", bOps)]+      case filter isWriteOp ops of+        [WriteFileOp _ content _] -> do+          T.isInfixOf "# Title" content `shouldBe` True+          T.isInfixOf "seihou:mod-b" content `shouldBe` True+          T.isInfixOf "section content" content `shouldBe` True+        other -> expectationFailure $ "Expected one WriteFileOp, got: " ++ show other++    it "PatchFileOp PrependFile prepends content" $ do+      let aOps = [WriteFileOp "README.md" "# Title\n" Template]+          bOps = [PatchFileOp "README.md" "header\n" PrependFile Template "mod-b"]+          (ops, _, _) = mergeOperations [("mod-a", aOps), ("mod-b", bOps)]+      case filter isWriteOp ops of+        [WriteFileOp _ content _] -> do+          -- header should appear before Title+          let headerIdx = T.length (fst (T.breakOn "header" content))+              titleIdx = T.length (fst (T.breakOn "# Title" content))+          (headerIdx < titleIdx) `shouldBe` True+        other -> expectationFailure $ "Expected one WriteFileOp, got: " ++ show other++    it "PatchFileOp targeting nonexistent file is preserved as PatchFileOp" $ do+      let bOps = [PatchFileOp "new.txt" "content\n" AppendFile Template "mod-b"]+          (ops, _, _) = mergeOperations [("mod-b", bOps)]+      -- PatchFileOp with no existing target is preserved so the execution+      -- engine can merge with the on-disk file and the diff engine avoids+      -- false conflict classification.+      length (filter isPatchOp ops) `shouldBe` 1++    it "multiple patches from different modules accumulate" $ do+      let aOps = [WriteFileOp "README.md" "# Title\n" Template]+          bOps = [PatchFileOp "README.md" "from B\n" AppendSection Template "mod-b"]+          cOps = [PatchFileOp "README.md" "from C\n" AppendSection Template "mod-c"]+          (ops, warnings, _) = mergeOperations [("mod-a", aOps), ("mod-b", bOps), ("mod-c", cOps)]+      case filter isWriteOp ops of+        [WriteFileOp _ content _] -> do+          T.isInfixOf "# Title" content `shouldBe` True+          T.isInfixOf "from B" content `shouldBe` True+          T.isInfixOf "from C" content `shouldBe` True+          T.isInfixOf "seihou:mod-b" content `shouldBe` True+          T.isInfixOf "seihou:mod-c" content `shouldBe` True+        other -> expectationFailure $ "Expected one WriteFileOp, got: " ++ show other+      -- Two ContentMerged warnings (one for B, one for C)+      length (filter isContentMerged warnings) `shouldBe` 2++    it "ContentMerged warning is generated for patch merge" $ do+      let aOps = [WriteFileOp "f.txt" "base\n" Template]+          bOps = [PatchFileOp "f.txt" "added\n" AppendFile Template "mod-b"]+          (_, warnings, _) = mergeOperations [("mod-a", aOps), ("mod-b", bOps)]+      any isContentMerged warnings `shouldBe` True+      any isFileOverwritten warnings `shouldBe` False++    it "PatchFileOp AppendLineIfAbsent deduplicates lines during merge" $ do+      let aOps = [WriteFileOp ".gitignore" "node_modules/\n.env\n" Template]+          bOps = [PatchFileOp ".gitignore" ".env\n.claude/\n" AppendLineIfAbsent Template "mod-b"]+          (ops, warnings, _) = mergeOperations [("mod-a", aOps), ("mod-b", bOps)]+      case filter isWriteOp ops of+        [WriteFileOp _ content _] -> do+          content `shouldBe` "node_modules/\n.env\n.claude/\n"+        other -> expectationFailure $ "Expected one WriteFileOp, got: " ++ show other+      any isContentMerged warnings `shouldBe` True++  describe "mergeOperations (structured merge)" $ do+    it "two Structured WriteFileOps for same JSON dest get deep-merged" $ do+      let aOps = [WriteFileOp "config.json" "{\"name\": \"foo\"}\n" Structured]+          bOps = [WriteFileOp "config.json" "{\"extra\": true}\n" Structured]+          (ops, warnings, _) = mergeOperations [("mod-a", aOps), ("mod-b", bOps)]+      case filter isWriteOp ops of+        [WriteFileOp _ content _] -> do+          T.isInfixOf "name" content `shouldBe` True+          T.isInfixOf "foo" content `shouldBe` True+          T.isInfixOf "extra" content `shouldBe` True+        other -> expectationFailure $ "Expected one WriteFileOp, got: " ++ show other+      any isContentMerged warnings `shouldBe` True+      any isFileOverwritten warnings `shouldBe` False++    it "disjoint JSON keys are combined" $ do+      let aOps = [WriteFileOp "out.json" "{\"a\": 1}\n" Structured]+          bOps = [WriteFileOp "out.json" "{\"b\": 2}\n" Structured]+          (ops, _, _) = mergeOperations [("mod-a", aOps), ("mod-b", bOps)]+      case filter isWriteOp ops of+        [WriteFileOp _ content _] -> do+          T.isInfixOf "\"a\"" content `shouldBe` True+          T.isInfixOf "\"b\"" content `shouldBe` True+        other -> expectationFailure $ "Expected one WriteFileOp, got: " ++ show other++    it "overlapping scalar keys use right-biased merge" $ do+      let aOps = [WriteFileOp "out.json" "{\"x\": 1}\n" Structured]+          bOps = [WriteFileOp "out.json" "{\"x\": 2}\n" Structured]+          (ops, _, _) = mergeOperations [("mod-a", aOps), ("mod-b", bOps)]+      case filter isWriteOp ops of+        [WriteFileOp _ content _] ->+          -- Right-biased: B's value wins+          T.isInfixOf "2" content `shouldBe` True+        other -> expectationFailure $ "Expected one WriteFileOp, got: " ++ show other++    it "nested objects are merged recursively" $ do+      let aOps = [WriteFileOp "out.json" "{\"obj\": {\"a\": 1}}\n" Structured]+          bOps = [WriteFileOp "out.json" "{\"obj\": {\"b\": 2}}\n" Structured]+          (ops, _, _) = mergeOperations [("mod-a", aOps), ("mod-b", bOps)]+      case filter isWriteOp ops of+        [WriteFileOp _ content _] -> do+          T.isInfixOf "\"a\"" content `shouldBe` True+          T.isInfixOf "\"b\"" content `shouldBe` True+        other -> expectationFailure $ "Expected one WriteFileOp, got: " ++ show other++    it "non-Structured WriteFileOps still use last-writer-wins" $ do+      let aOps = [WriteFileOp "README.md" "from A" Template]+          bOps = [WriteFileOp "README.md" "from B" Template]+          (_, warnings, _) = mergeOperations [("mod-a", aOps), ("mod-b", bOps)]+      any isFileOverwritten warnings `shouldBe` True+      any isContentMerged warnings `shouldBe` False++    it "YAML structured merge works" $ do+      let aOps = [WriteFileOp "config.yaml" "name: foo\n" Structured]+          bOps = [WriteFileOp "config.yaml" "extra: true\n" Structured]+          (ops, warnings, _) = mergeOperations [("mod-a", aOps), ("mod-b", bOps)]+      case filter isWriteOp ops of+        [WriteFileOp _ content _] -> do+          T.isInfixOf "name" content `shouldBe` True+          T.isInfixOf "extra" content `shouldBe` True+        other -> expectationFailure $ "Expected one WriteFileOp, got: " ++ show other+      any isContentMerged warnings `shouldBe` True++-- Helpers++isWriteOp :: Operation -> Bool+isWriteOp (WriteFileOp {}) = True+isWriteOp _ = False++isPatchOp :: Operation -> Bool+isPatchOp (PatchFileOp {}) = True+isPatchOp _ = False++destOfOp' :: Operation -> Maybe FilePath+destOfOp' (WriteFileOp d _ _) = Just d+destOfOp' (CopyFileOp _ d) = Just d+destOfOp' (PatchFileOp d _ _ _ _) = Just d+destOfOp' _ = Nothing++isContentMerged :: CompositionWarning -> Bool+isContentMerged (ContentMerged {}) = True+isContentMerged _ = False++isFileOverwritten :: CompositionWarning -> Bool+isFileOverwritten (FileOverwritten {}) = True+isFileOverwritten _ = False
+ test/Seihou/Composition/RecipeSpec.hs view
@@ -0,0 +1,113 @@+module Seihou.Composition.RecipeSpec (tests) where++import Data.Map.Strict qualified as Map+import Data.Text (Text)+import Seihou.Composition.Recipe (expandRecipe)+import Seihou.Core.Types+import Test.Hspec+import Test.Tasty+import Test.Tasty.Hspec (testSpec)++tests :: IO TestTree+tests = testSpec "Seihou.Composition.Recipe" spec++expectExpanded :: Recipe -> (ModuleName, [ModuleName], Map.Map VarName Text, [VarDecl], [Prompt])+expectExpanded recipe =+  case expandRecipe recipe of+    Right expanded -> expanded+    Left errs -> error ("expected recipe expansion, got errors: " <> show errs)++spec :: Spec+spec = do+  describe "expandRecipe" $ do+    it "returns correct primary and additional module names" $ do+      let recipe =+            Recipe+              { name = "combo",+                version = Just "1.0.0",+                description = Nothing,+                modules =+                  [ simpleDep "mod-a",+                    simpleDep "mod-b",+                    simpleDep "mod-c"+                  ],+                vars = [],+                prompts = []+              }+          (primary, additional, _, _, _) = expectExpanded recipe+      primary `shouldBe` ModuleName "mod-a"+      additional `shouldBe` [ModuleName "mod-b", ModuleName "mod-c"]++    it "collects variable overrides from module entries" $ do+      let recipe =+            Recipe+              { name = "pinned",+                version = Nothing,+                description = Nothing,+                modules =+                  [ Dependency (ModuleName "base") (Map.singleton "project.name" "my-app"),+                    Dependency (ModuleName "nix") (Map.singleton "nix.system" "aarch64-darwin")+                  ],+                vars = [],+                prompts = []+              }+          (_, _, overrides, _, _) = expectExpanded recipe+      Map.lookup (VarName "project.name") overrides `shouldBe` Just "my-app"+      Map.lookup (VarName "nix.system") overrides `shouldBe` Just "aarch64-darwin"++    it "passes through recipe-level vars and prompts" $ do+      let recipeVar =+            VarDecl+              { name = "project.name",+                type_ = VTText,+                default_ = Nothing,+                description = Just "Project name",+                required = True,+                validation = Nothing+              }+          recipePrompt =+            Prompt+              { var = "project.name",+                text = "Enter name:",+                condition = Nothing,+                choices = Nothing+              }+          recipe =+            Recipe+              { name = "prompted",+                version = Nothing,+                description = Nothing,+                modules = [simpleDep "base"],+                vars = [recipeVar],+                prompts = [recipePrompt]+              }+          (_, _, _, vars, prompts) = expectExpanded recipe+      vars `shouldBe` [recipeVar]+      prompts `shouldBe` [recipePrompt]++    it "handles a single-module recipe (alias)" $ do+      let recipe =+            Recipe+              { name = "alias",+                version = Nothing,+                description = Nothing,+                modules = [simpleDep "the-module"],+                vars = [],+                prompts = []+              }+          (primary, additional, overrides, _, _) = expectExpanded recipe+      primary `shouldBe` ModuleName "the-module"+      additional `shouldBe` []+      Map.null overrides `shouldBe` True++    it "returns validation errors for an empty recipe" $ do+      let recipe =+            Recipe+              { name = "empty",+                version = Nothing,+                description = Nothing,+                modules = [],+                vars = [],+                prompts = []+              }+      expandRecipe recipe `shouldBe` Left ["recipe must list at least one module"]
+ test/Seihou/Composition/ResolveSpec.hs view
@@ -0,0 +1,448 @@+module Seihou.Composition.ResolveSpec (tests) where++import Data.Map.Strict (Map)+import Data.Map.Strict qualified as Map+import Seihou.Composition.Instance (ModuleInstance (..), mkInstance, primaryInstance)+import Seihou.Composition.Resolve+import Seihou.Core.Types+import Seihou.Core.Variable (diagnoseResolution)+import Test.Hspec+import Test.Tasty+import Test.Tasty.Hspec (testSpec)++tests :: IO TestTree+tests = testSpec "Seihou.Composition.Resolve" spec++-- | Helper to create a minimal module.+mkModule :: ModuleName -> [ModuleName] -> [VarDecl] -> [VarExport] -> Module+mkModule name deps vars exports =+  Module+    { name = name,+      version = Nothing,+      description = Nothing,+      vars = vars,+      exports = exports,+      prompts = [],+      steps = [],+      commands = [],+      dependencies = map simpleDep deps,+      removal = Nothing,+      migrations = []+    }++-- | Helper to create a module with parameterized dependencies.+mkModuleWithDeps :: ModuleName -> [Dependency] -> [VarDecl] -> [VarExport] -> Module+mkModuleWithDeps name deps vars exports =+  Module+    { name = name,+      version = Nothing,+      description = Nothing,+      vars = vars,+      exports = exports,+      prompts = [],+      steps = [],+      commands = [],+      dependencies = deps,+      removal = Nothing,+      migrations = []+    }++-- | Helper to create a text variable declaration.+mkTextVar :: VarName -> Maybe VarValue -> Bool -> VarDecl+mkTextVar name defVal required =+  VarDecl+    { name = name,+      type_ = VTText,+      default_ = defVal,+      description = Nothing,+      required = required,+      validation = Nothing+    }++-- | Helper to create an export without alias.+mkExport :: VarName -> VarExport+mkExport name = VarExport {var = name, alias = Nothing}++-- | Helper to create an export with alias.+mkExportAs :: VarName -> VarName -> VarExport+mkExportAs name alias' = VarExport {var = name, alias = Just alias'}++-- | Wrap a list of @(Module, FilePath)@ into instance-keyed triples,+-- using 'emptyParentVars' for every module. Existing single-instance+-- tests use this to migrate onto the new API without churn.+asInstances :: [(Module, FilePath)] -> [(ModuleInstance, Module, FilePath)]+asInstances pairs = [(primaryInstance m.name, m, dir) | (m, dir) <- pairs]++-- | Look up the resolved variables for a module by its bare name,+-- assuming the composition contains a single primary instance of it.+byName :: ModuleName -> Map ModuleInstance (Map VarName a) -> Map VarName a+byName n = Map.findWithDefault Map.empty (primaryInstance n)++spec :: Spec+spec = do+  describe "exportedVars" $ do+    it "exports a variable under its original name" $ do+      let m = mkModule "base" [] [mkTextVar "project.name" (Just (VText "test")) False] [mkExport "project.name"]+          resolved = Map.singleton "project.name" (ResolvedVar (VText "my-app") FromDefault (mkTextVar "project.name" (Just (VText "test")) False))+          result = exportedVars m resolved+      Map.lookup "project.name" result `shouldBe` Just (VText "my-app")++    it "exports a variable under its alias" $ do+      let m = mkModule "base" [] [mkTextVar "project.name" (Just (VText "test")) False] [mkExportAs "project.name" "app.name"]+          resolved = Map.singleton "project.name" (ResolvedVar (VText "my-app") FromDefault (mkTextVar "project.name" (Just (VText "test")) False))+          result = exportedVars m resolved+      Map.lookup "app.name" result `shouldBe` Just (VText "my-app")+      Map.lookup "project.name" result `shouldBe` Nothing++    it "skips exports for unresolved variables" $ do+      let m = mkModule "base" [] [] [mkExport "missing.var"]+          resolved = Map.empty+          result = exportedVars m resolved+      Map.null result `shouldBe` True++  describe "resolveComposedVariables" $ do+    it "resolves a single module with no dependencies" $ do+      let m = mkModule "base" [] [mkTextVar "project.name" (Just (VText "default")) False] []+          modules = asInstances [(m, "/fake/base")]+      case resolveComposedVariables modules Map.empty Map.empty "" "" Map.empty Map.empty Map.empty Map.empty of+        Left errs -> expectationFailure $ "Expected Right, got: " ++ show errs+        Right result -> do+          let baseVars = byName "base" result+          (.value) (baseVars Map.! "project.name") `shouldBe` VText "default"++    it "flows exported variable from dependency to dependent" $ do+      let base = mkModule "base" [] [mkTextVar "project.name" (Just (VText "my-app")) False] [mkExport "project.name"]+          app = mkModule "app" ["base"] [mkTextVar "project.name" Nothing True] []+          modules = asInstances [(base, "/fake/base"), (app, "/fake/app")]+      case resolveComposedVariables modules Map.empty Map.empty "" "" Map.empty Map.empty Map.empty Map.empty of+        Left errs -> expectationFailure $ "Expected Right, got: " ++ show errs+        Right result -> do+          let appVars = byName "app" result+          (.value) (appVars Map.! "project.name") `shouldBe` VText "my-app"++    it "export overrides module's own default" $ do+      let base = mkModule "base" [] [mkTextVar "project.name" (Just (VText "from-base")) False] [mkExport "project.name"]+          app = mkModule "app" ["base"] [mkTextVar "project.name" (Just (VText "from-app")) False] []+          modules = asInstances [(base, "/fake/base"), (app, "/fake/app")]+      case resolveComposedVariables modules Map.empty Map.empty "" "" Map.empty Map.empty Map.empty Map.empty of+        Left errs -> expectationFailure $ "Expected Right, got: " ++ show errs+        Right result -> do+          let appVars = byName "app" result+          (.value) (appVars Map.! "project.name") `shouldBe` VText "from-base"++    it "CLI override beats exported value" $ do+      let base = mkModule "base" [] [mkTextVar "project.name" (Just (VText "from-base")) False] [mkExport "project.name"]+          app = mkModule "app" ["base"] [mkTextVar "project.name" Nothing True] []+          modules = asInstances [(base, "/fake/base"), (app, "/fake/app")]+          cliOverrides = Map.singleton "project.name" "from-cli"+      case resolveComposedVariables modules cliOverrides Map.empty "" "" Map.empty Map.empty Map.empty Map.empty of+        Left errs -> expectationFailure $ "Expected Right, got: " ++ show errs+        Right result -> do+          let appVars = byName "app" result+          (.value) (appVars Map.! "project.name") `shouldBe` VText "from-cli"++    it "inherits non-declared exports from dependency" $ do+      let base = mkModule "base" [] [mkTextVar "project.name" (Just (VText "my-app")) False] [mkExport "project.name"]+          -- app does NOT declare project.name but depends on base+          app = mkModule "app" ["base"] [mkTextVar "app.version" (Just (VText "1.0")) False] []+          modules = asInstances [(base, "/fake/base"), (app, "/fake/app")]+      case resolveComposedVariables modules Map.empty Map.empty "" "" Map.empty Map.empty Map.empty Map.empty of+        Left errs -> expectationFailure $ "Expected Right, got: " ++ show errs+        Right result -> do+          let appVars = byName "app" result+          -- app inherits project.name even though it doesn't declare it+          (.value) (appVars Map.! "project.name") `shouldBe` VText "my-app"+          -- app also has its own variable+          (.value) (appVars Map.! "app.version") `shouldBe` VText "1.0"++    it "handles aliased exports" $ do+      let base = mkModule "base" [] [mkTextVar "project.name" (Just (VText "my-app")) False] [mkExportAs "project.name" "app.name"]+          app = mkModule "app" ["base"] [mkTextVar "app.name" Nothing True] []+          modules = asInstances [(base, "/fake/base"), (app, "/fake/app")]+      case resolveComposedVariables modules Map.empty Map.empty "" "" Map.empty Map.empty Map.empty Map.empty of+        Left errs -> expectationFailure $ "Expected Right, got: " ++ show errs+        Right result -> do+          let appVars = byName "app" result+          (.value) (appVars Map.! "app.name") `shouldBe` VText "my-app"++    it "handles diamond dependency with shared export" $ do+      let d = mkModule "d" [] [mkTextVar "sys.arch" (Just (VText "x86_64")) False] [mkExport "sys.arch"]+          b = mkModule "b" ["d"] [mkTextVar "sys.arch" Nothing True] [mkExport "sys.arch"]+          c = mkModule "c" ["d"] [mkTextVar "sys.arch" Nothing True] []+          a = mkModule "a" ["b", "c"] [mkTextVar "sys.arch" Nothing True] []+          modules = asInstances [(d, "/d"), (b, "/b"), (c, "/c"), (a, "/a")]+      case resolveComposedVariables modules Map.empty Map.empty "" "" Map.empty Map.empty Map.empty Map.empty of+        Left errs -> expectationFailure $ "Expected Right, got: " ++ show errs+        Right result -> do+          -- All modules should see sys.arch from d+          (.value) (byName "d" result Map.! "sys.arch") `shouldBe` VText "x86_64"+          (.value) (byName "b" result Map.! "sys.arch") `shouldBe` VText "x86_64"+          (.value) (byName "c" result Map.! "sys.arch") `shouldBe` VText "x86_64"+          (.value) (byName "a" result Map.! "sys.arch") `shouldBe` VText "x86_64"++  describe "resolveComposedVariables (with config layers)" $ do+    it "resolves from global config when no other source provides value" $ do+      let m = mkModule "base" [] [mkTextVar "license" Nothing True] []+          modules = asInstances [(m, "/fake/base")]+          globalCfg = Map.fromList [("license", "MIT")]+      case resolveComposedVariables modules Map.empty Map.empty "" "" Map.empty Map.empty Map.empty globalCfg of+        Left errs -> expectationFailure $ "Expected Right, got: " ++ show errs+        Right result -> do+          let baseVars = byName "base" result+          (.value) (baseVars Map.! "license") `shouldBe` VText "MIT"+          (.source) (baseVars Map.! "license") `shouldBe` FromGlobalConfig++    it "local config overrides global config in composed resolution" $ do+      let m = mkModule "base" [] [mkTextVar "license" Nothing True] []+          modules = asInstances [(m, "/fake/base")]+          localCfg = Map.fromList [("license", "BSD3")]+          globalCfg = Map.fromList [("license", "MIT")]+      case resolveComposedVariables modules Map.empty Map.empty "" "" localCfg Map.empty Map.empty globalCfg of+        Left errs -> expectationFailure $ "Expected Right, got: " ++ show errs+        Right result -> do+          let baseVars = byName "base" result+          (.value) (baseVars Map.! "license") `shouldBe` VText "BSD3"+          (.source) (baseVars Map.! "license") `shouldBe` FromLocalConfig++    it "CLI override beats config layers in composed resolution" $ do+      let m = mkModule "base" [] [mkTextVar "license" Nothing True] []+          modules = asInstances [(m, "/fake/base")]+          cliOverrides = Map.singleton "license" "cli-license"+          localCfg = Map.fromList [("license", "local-license")]+          globalCfg = Map.fromList [("license", "global-license")]+      case resolveComposedVariables modules cliOverrides Map.empty "" "" localCfg Map.empty Map.empty globalCfg of+        Left errs -> expectationFailure $ "Expected Right, got: " ++ show errs+        Right result -> do+          let baseVars = byName "base" result+          (.value) (baseVars Map.! "license") `shouldBe` VText "cli-license"+          (.source) (baseVars Map.! "license") `shouldBe` FromCLI++    it "config layers flow through multi-module composition" $ do+      let base = mkModule "base" [] [mkTextVar "license" Nothing True] [mkExport "license"]+          app = mkModule "app" ["base"] [mkTextVar "license" Nothing True] []+          modules = asInstances [(base, "/fake/base"), (app, "/fake/app")]+          globalCfg = Map.fromList [("license", "MIT")]+      case resolveComposedVariables modules Map.empty Map.empty "" "" Map.empty Map.empty Map.empty globalCfg of+        Left errs -> expectationFailure $ "Expected Right, got: " ++ show errs+        Right result -> do+          -- base gets license from global config+          let baseVars = byName "base" result+          (.value) (baseVars Map.! "license") `shouldBe` VText "MIT"+          (.source) (baseVars Map.! "license") `shouldBe` FromGlobalConfig+          -- app also gets license from global config (it declares the var)+          let appVars = byName "app" result+          (.value) (appVars Map.! "license") `shouldBe` VText "MIT"++  describe "end-to-end config hierarchy auto-resolution" $ do+    it "resolves all variables from different config layers with correct precedence" $ do+      -- Scenario: A module with 4 variables, each resolved from a different layer+      let decls =+            [ mkTextVar "project.name" Nothing True,+              mkTextVar "license" Nothing False,+              mkTextVar "haskell.ghc" Nothing False,+              mkTextVar "author.name" Nothing False+            ]+          m = mkModule "haskell-app" [] decls [mkExport "project.name"]+          modules = asInstances [(m, "/fake/haskell-app")]+          cliOverrides = Map.singleton "project.name" "my-app"+          envVars = Map.singleton "SEIHOU_VAR_LICENSE" "Apache"+          localCfg = Map.fromList [("haskell.ghc", "9.12.2")]+          globalCfg = Map.fromList [("author.name", "Jane Doe"), ("license", "MIT")]+      case resolveComposedVariables modules cliOverrides envVars "haskell" "" localCfg Map.empty Map.empty globalCfg of+        Left errs -> expectationFailure $ "Expected Right, got: " ++ show errs+        Right result -> do+          let vars = byName "haskell-app" result+          -- CLI wins for project.name+          (.value) (vars Map.! "project.name") `shouldBe` VText "my-app"+          (.source) (vars Map.! "project.name") `shouldBe` FromCLI+          -- Env wins over global config for license+          (.value) (vars Map.! "license") `shouldBe` VText "Apache"+          (.source) (vars Map.! "license") `shouldBe` FromEnv "SEIHOU_VAR_LICENSE"+          -- Local config provides haskell.ghc+          (.value) (vars Map.! "haskell.ghc") `shouldBe` VText "9.12.2"+          (.source) (vars Map.! "haskell.ghc") `shouldBe` FromLocalConfig+          -- Global config provides author.name+          (.value) (vars Map.! "author.name") `shouldBe` VText "Jane Doe"+          (.source) (vars Map.! "author.name") `shouldBe` FromGlobalConfig++    it "optional variables without values are omitted, not errors" $ do+      let decls =+            [ mkTextVar "project.name" Nothing True,+              mkTextVar "optional.missing" Nothing False+            ]+          m = mkModule "test" [] decls []+          modules = asInstances [(m, "/fake/test")]+          cliOverrides = Map.singleton "project.name" "app"+      case resolveComposedVariables modules cliOverrides Map.empty "" "" Map.empty Map.empty Map.empty Map.empty of+        Left errs -> expectationFailure $ "Expected Right, got: " ++ show errs+        Right result -> do+          let vars = byName "test" result+          (.value) (vars Map.! "project.name") `shouldBe` VText "app"+          Map.member "optional.missing" vars `shouldBe` False++    it "diagnostics detect unused config keys and unresolved optional vars" $ do+      let decls =+            [ mkTextVar "project.name" Nothing True,+              mkTextVar "optional.unset" Nothing False+            ]+          m = mkModule "test" [] decls []+          modules = asInstances [(m, "/fake/test")]+          cliOverrides = Map.singleton "project.name" "app"+          globalCfg = Map.fromList [("typo.key", "oops")]+      case resolveComposedVariables modules cliOverrides Map.empty "" "" Map.empty Map.empty Map.empty globalCfg of+        Left errs -> expectationFailure $ "Expected Right, got: " ++ show errs+        Right result -> do+          let allResolved = Map.unions (Map.elems result)+              allDecls = concatMap (\(_, mm, _) -> mm.vars) modules+              (unusedKeys, unresolvedOpt) = diagnoseResolution allResolved allDecls Map.empty Map.empty Map.empty globalCfg+          unusedKeys `shouldBe` [VarName "typo.key"]+          unresolvedOpt `shouldBe` [VarName "optional.unset"]++    it "context config overrides global config in composed resolution" $ do+      let m = mkModule "base" [] [mkTextVar "user.email" Nothing True] []+          modules = asInstances [(m, "/fake/base")]+          ctxCfg = Map.fromList [("user.email", "work@example.com")]+          globalCfg = Map.fromList [("user.email", "default@example.com")]+      case resolveComposedVariables modules Map.empty Map.empty "" "work" Map.empty Map.empty ctxCfg globalCfg of+        Left errs -> expectationFailure $ "Expected Right, got: " ++ show errs+        Right result -> do+          let baseVars = byName "base" result+          (.value) (baseVars Map.! "user.email") `shouldBe` VText "work@example.com"+          (.source) (baseVars Map.! "user.email") `shouldBe` FromContextConfig "work"++    it "context flows through multi-module composition" $ do+      let base = mkModule "base" [] [mkTextVar "user.email" Nothing True] [mkExport "user.email"]+          app = mkModule "app" ["base"] [mkTextVar "user.email" Nothing True] []+          modules = asInstances [(base, "/fake/base"), (app, "/fake/app")]+          ctxCfg = Map.fromList [("user.email", "work@example.com")]+      case resolveComposedVariables modules Map.empty Map.empty "" "work" Map.empty Map.empty ctxCfg Map.empty of+        Left errs -> expectationFailure $ "Expected Right, got: " ++ show errs+        Right result -> do+          let baseVars = byName "base" result+          (.value) (baseVars Map.! "user.email") `shouldBe` VText "work@example.com"+          let appVars = byName "app" result+          (.value) (appVars Map.! "user.email") `shouldBe` VText "work@example.com"++    it "multi-module composition: config values flow through exports" $ do+      let baseDecls =+            [ mkTextVar "project.name" Nothing True,+              mkTextVar "license" Nothing False+            ]+          base = mkModule "base" [] baseDecls [mkExport "project.name", mkExport "license"]+          appDecls =+            [ mkTextVar "project.name" Nothing True,+              mkTextVar "license" Nothing False+            ]+          app = mkModule "app" ["base"] appDecls []+          modules = asInstances [(base, "/fake/base"), (app, "/fake/app")]+          globalCfg = Map.fromList [("project.name", "global-app"), ("license", "MIT")]+          localCfg = Map.fromList [("project.name", "local-app")]+      case resolveComposedVariables modules Map.empty Map.empty "" "" localCfg Map.empty Map.empty globalCfg of+        Left errs -> expectationFailure $ "Expected Right, got: " ++ show errs+        Right result -> do+          -- base: local overrides global for project.name+          let baseVars = byName "base" result+          (.value) (baseVars Map.! "project.name") `shouldBe` VText "local-app"+          (.source) (baseVars Map.! "project.name") `shouldBe` FromLocalConfig+          (.value) (baseVars Map.! "license") `shouldBe` VText "MIT"+          (.source) (baseVars Map.! "license") `shouldBe` FromGlobalConfig+          -- app: same values, same precedence (declares its own vars, config wins)+          let appVars = byName "app" result+          (.value) (appVars Map.! "project.name") `shouldBe` VText "local-app"+          (.value) (appVars Map.! "license") `shouldBe` VText "MIT"++  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")] [] []+          childInst = mkInstance "child" (ParentVars (Map.singleton "skill.name" "exec-plan"))+          parentInst = primaryInstance "parent"+          modules = [(childInst, child, "/fake/child"), (parentInst, parent', "/fake/parent")]+      case resolveComposedVariables modules Map.empty Map.empty "" "" Map.empty Map.empty Map.empty Map.empty of+        Left errs -> expectationFailure $ "Expected Right, got: " ++ show errs+        Right result -> do+          let childVars = Map.findWithDefault Map.empty childInst result+          (.value) (childVars Map.! "skill.name") `shouldBe` VText "exec-plan"+          (.source) (childVars Map.! "skill.name") `shouldBe` FromParent "parent"++    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")] [] []+          childInst = mkInstance "child" (ParentVars (Map.singleton "skill.name" "new"))+          parentInst = primaryInstance "parent"+          modules = [(childInst, child, "/fake/child"), (parentInst, parent', "/fake/parent")]+      case resolveComposedVariables modules Map.empty Map.empty "" "" Map.empty Map.empty Map.empty Map.empty of+        Left errs -> expectationFailure $ "Expected Right, got: " ++ show errs+        Right result -> do+          let childVars = Map.findWithDefault Map.empty childInst result+          (.value) (childVars Map.! "skill.name") `shouldBe` VText "new"+          (.source) (childVars Map.! "skill.name") `shouldBe` FromParent "parent"++    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")] [] []+          childInst = mkInstance "child" (ParentVars (Map.singleton "skill.name" "from-parent"))+          parentInst = primaryInstance "parent"+          modules = [(childInst, child, "/fake/child"), (parentInst, parent', "/fake/parent")]+          cliOverrides = Map.singleton "skill.name" "from-cli"+      case resolveComposedVariables modules cliOverrides Map.empty "" "" Map.empty Map.empty Map.empty Map.empty of+        Left errs -> expectationFailure $ "Expected Right, got: " ++ show errs+        Right result -> do+          let childVars = Map.findWithDefault Map.empty childInst result+          (.value) (childVars Map.! "skill.name") `shouldBe` VText "from-cli"+          (.source) (childVars Map.! "skill.name") `shouldBe` FromCLI++    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")] [] []+          childInst = mkInstance "child" (ParentVars (Map.singleton "skill.name" "parent-val"))+          parentInst = primaryInstance "parent"+          modules = [(childInst, child, "/fake/child"), (parentInst, parent', "/fake/parent")]+          globalCfg = Map.fromList [("skill.name", "global-val")]+      case resolveComposedVariables modules Map.empty Map.empty "" "" Map.empty Map.empty Map.empty globalCfg of+        Left errs -> expectationFailure $ "Expected Right, got: " ++ show errs+        Right result -> do+          let childVars = Map.findWithDefault Map.empty childInst result+          (.value) (childVars Map.! "skill.name") `shouldBe` VText "global-val"+          (.source) (childVars Map.! "skill.name") `shouldBe` FromGlobalConfig++    it "two parents supplying different bindings produce two distinct child instances" $ do+      -- The regression case from ExecPlan 10: master-plan and exec-plan both+      -- depend on claude-skill-link with different skill.name bindings. Both+      -- invocations must resolve independently.+      let helper =+            mkModule+              "helper"+              []+              [mkTextVar "skill.name" Nothing True]+              [mkExport "skill.name"]+          parentA =+            mkModuleWithDeps+              "parent-a"+              [Dependency "helper" (Map.singleton "skill.name" "exec-plan")]+              []+              []+          parentB =+            mkModuleWithDeps+              "parent-b"+              [Dependency "helper" (Map.singleton "skill.name" "master-plan")]+              []+              []+          instA = mkInstance "helper" (ParentVars (Map.singleton "skill.name" "exec-plan"))+          instB = mkInstance "helper" (ParentVars (Map.singleton "skill.name" "master-plan"))+          parentAInst = primaryInstance "parent-a"+          parentBInst = primaryInstance "parent-b"+          modules =+            [ (instA, helper, "/fake/helper"),+              (instB, helper, "/fake/helper"),+              (parentAInst, parentA, "/fake/parent-a"),+              (parentBInst, parentB, "/fake/parent-b")+            ]+      case resolveComposedVariables modules Map.empty Map.empty "" "" Map.empty Map.empty Map.empty Map.empty of+        Left errs -> expectationFailure $ "Expected Right, got: " ++ show errs+        Right result -> do+          Map.size result `shouldBe` 4+          let varsA = Map.findWithDefault Map.empty instA result+              varsB = Map.findWithDefault Map.empty instB result+          (.value) (varsA Map.! "skill.name") `shouldBe` VText "exec-plan"+          (.value) (varsB Map.! "skill.name") `shouldBe` VText "master-plan"
+ test/Seihou/Core/AgentPromptSpec.hs view
@@ -0,0 +1,365 @@+module Seihou.Core.AgentPromptSpec (tests) where++import Data.Text qualified as T+import Seihou.Core.AgentPrompt (validateAgentPrompt)+import Seihou.Core.Module (DiscoveredRunnable (..), RunnableKind (..), discoverAllRunnables, discoverRunnable)+import Seihou.Core.Types+import Seihou.Dhall.Eval (evalAgentPromptFromFile)+import System.Directory (createDirectoryIfMissing)+import System.FilePath ((</>))+import System.IO.Temp (withSystemTempDirectory)+import Test.Hspec+import Test.Tasty+import Test.Tasty.Hspec (testSpec)++tests :: IO TestTree+tests = testSpec "Seihou.Core.AgentPrompt" spec++goodAgentPrompt :: AgentPrompt+goodAgentPrompt =+  AgentPrompt+    "review-changes"+    (Just "0.1.0")+    (Just "Review local changes")+    "Review the current repository."+    [VarDecl "project.name" VTText Nothing Nothing True Nothing]+    [Prompt {var = "project.name", text = "Project?", condition = Nothing, choices = Nothing}]+    [CommandVar "git.branch" "git branch --show-current" Nothing Nothing True (Just 4096)]+    [PromptGuidance "Repository workflow" "Inspect first." Nothing]+    []+    Nothing+    ["review"]+    Nothing++withAgentPromptName :: ModuleName -> AgentPrompt -> AgentPrompt+withAgentPromptName n p =+  AgentPrompt n p.version p.description p.prompt p.vars p.prompts p.commandVars p.guidance p.files p.allowedTools p.tags p.launch++withAgentPromptPrompt :: T.Text -> AgentPrompt -> AgentPrompt+withAgentPromptPrompt body p =+  AgentPrompt p.name p.version p.description body p.vars p.prompts p.commandVars p.guidance p.files p.allowedTools p.tags p.launch++withAgentPromptVars :: [VarDecl] -> AgentPrompt -> AgentPrompt+withAgentPromptVars vars p =+  AgentPrompt p.name p.version p.description p.prompt vars p.prompts p.commandVars p.guidance p.files p.allowedTools p.tags p.launch++withAgentPromptPrompts :: [Prompt] -> AgentPrompt -> AgentPrompt+withAgentPromptPrompts prompts p =+  AgentPrompt p.name p.version p.description p.prompt p.vars prompts p.commandVars p.guidance p.files p.allowedTools p.tags p.launch++withAgentPromptCommandVars :: [CommandVar] -> AgentPrompt -> AgentPrompt+withAgentPromptCommandVars commandVars p =+  AgentPrompt p.name p.version p.description p.prompt p.vars p.prompts commandVars p.guidance p.files p.allowedTools p.tags p.launch++withAgentPromptGuidance :: [PromptGuidance] -> AgentPrompt -> AgentPrompt+withAgentPromptGuidance guidance p =+  AgentPrompt p.name p.version p.description p.prompt p.vars p.prompts p.commandVars guidance p.files p.allowedTools p.tags p.launch++withAgentPromptFiles :: [BlueprintFile] -> AgentPrompt -> AgentPrompt+withAgentPromptFiles files p =+  AgentPrompt p.name p.version p.description p.prompt p.vars p.prompts p.commandVars p.guidance files p.allowedTools p.tags p.launch++hasError :: T.Text -> [T.Text] -> Bool+hasError needle = any (T.isInfixOf needle)++spec :: Spec+spec = do+  describe "evalAgentPromptFromFile" $ do+    it "decodes prompt.dhall with command variables, guidance, and launch metadata" $ do+      withSystemTempDirectory "seihou-prompt" $ \tmpDir -> do+        let promptDir = tmpDir </> "review-changes"+        createDirectoryIfMissing True promptDir+        writeFile (promptDir </> "prompt.dhall") (samplePromptDhall "review-changes")+        result <- evalAgentPromptFromFile (promptDir </> "prompt.dhall")+        case result of+          Right p -> do+            p.name `shouldBe` "review-changes"+            p.description `shouldBe` Just "Review local changes"+            length p.commandVars `shouldBe` 1+            p.guidance+              `shouldBe` [ PromptGuidance+                             "Repository workflow"+                             "Prefer focused validation commands."+                             (Just (ExprEq "git.branch" (VText "main")))+                         ]+            fmap (.provider) p.launch `shouldBe` Just (Just "codex-cli")+          Left err -> expectationFailure ("Expected Right, got: " <> show err)++    it "decodes prompt.dhall without guidance as an empty list" $ do+      withSystemTempDirectory "seihou-prompt" $ \tmpDir -> do+        let promptDir = tmpDir </> "review-changes"+        createDirectoryIfMissing True promptDir+        writeFile (promptDir </> "prompt.dhall") (samplePromptDhallWithoutGuidance "review-changes")+        result <- evalAgentPromptFromFile (promptDir </> "prompt.dhall")+        case result of+          Right p -> p.guidance `shouldBe` []+          Left err -> expectationFailure ("Expected Right, got: " <> show err)++  describe "validateAgentPrompt" $ do+    it "accepts a well-formed prompt" $ do+      withSystemTempDirectory "seihou-prompt" $ \tmpDir -> do+        result <- validateAgentPrompt tmpDir goodAgentPrompt+        case result of+          Right p -> p.name `shouldBe` "review-changes"+          Left err -> expectationFailure ("Expected Right, got: " <> show err)++    it "rejects an invalid prompt name" $ do+      withSystemTempDirectory "seihou-prompt" $ \tmpDir -> do+        result <- validateAgentPrompt tmpDir (withAgentPromptName "Bad_Name" goodAgentPrompt)+        case result of+          Left (ValidationError _ errs) ->+            hasError "prompt name must match" errs `shouldBe` True+          other -> expectationFailure ("Expected ValidationError, got: " <> show other)++    it "rejects an empty prompt body" $ do+      withSystemTempDirectory "seihou-prompt" $ \tmpDir -> do+        result <- validateAgentPrompt tmpDir (withAgentPromptPrompt "   \n " goodAgentPrompt)+        case result of+          Left (ValidationError _ errs) ->+            hasError "prompt body must not be empty" errs `shouldBe` True+          other -> expectationFailure ("Expected ValidationError, got: " <> show other)++    it "rejects duplicate typed variables" $ do+      withSystemTempDirectory "seihou-prompt" $ \tmpDir -> do+        let bad =+              withAgentPromptVars+                [ VarDecl "x" VTText Nothing Nothing True Nothing,+                  VarDecl "x" VTBool Nothing Nothing False Nothing+                ]+                goodAgentPrompt+        result <- validateAgentPrompt tmpDir bad+        case result of+          Left (ValidationError _ errs) ->+            hasError "duplicate variable name" errs `shouldBe` True+          other -> expectationFailure ("Expected ValidationError, got: " <> show other)++    it "rejects prompts that reference undeclared variables" $ do+      withSystemTempDirectory "seihou-prompt" $ \tmpDir -> do+        let bad =+              withAgentPromptPrompts+                [Prompt {var = "missing", text = "?", condition = Nothing, choices = Nothing}]+                goodAgentPrompt+        result <- validateAgentPrompt tmpDir bad+        case result of+          Left (ValidationError _ errs) ->+            hasError "prompt references undeclared variable" errs `shouldBe` True+          other -> expectationFailure ("Expected ValidationError, got: " <> show other)++    it "rejects unsafe command variables" $ do+      withSystemTempDirectory "seihou-prompt" $ \tmpDir -> do+        let bad =+              withAgentPromptCommandVars+                [ CommandVar "git.branch" "" (Just "../outside") Nothing True (Just 0),+                  CommandVar "git.branch" "git status" Nothing Nothing True Nothing+                ]+                goodAgentPrompt+        result <- validateAgentPrompt tmpDir bad+        case result of+          Left (ValidationError _ errs) -> do+            hasError "duplicate command variable name" errs `shouldBe` True+            hasError "run must not be empty" errs `shouldBe` True+            hasError "must not contain '..'" errs `shouldBe` True+            hasError "maxBytes must be greater than zero" errs `shouldBe` True+          other -> expectationFailure ("Expected ValidationError, got: " <> show other)++    it "accepts guidance that references declared typed and command variables" $ do+      withSystemTempDirectory "seihou-prompt" $ \tmpDir -> do+        let guided =+              withAgentPromptGuidance+                [ PromptGuidance "Project" "Use the declared project name." (Just (ExprIsSet "project.name")),+                  PromptGuidance "Branch" "Account for branch-specific workflow." (Just (ExprIsSet "git.branch"))+                ]+                goodAgentPrompt+        result <- validateAgentPrompt tmpDir guided+        case result of+          Right p -> length p.guidance `shouldBe` 2+          Left err -> expectationFailure ("Expected Right, got: " <> show err)++    it "rejects guidance with blank titles or bodies" $ do+      withSystemTempDirectory "seihou-prompt" $ \tmpDir -> do+        let bad =+              withAgentPromptGuidance+                [ PromptGuidance "  " "Body" Nothing,+                  PromptGuidance "Title" " \n " Nothing+                ]+                goodAgentPrompt+        result <- validateAgentPrompt tmpDir bad+        case result of+          Left (ValidationError _ errs) -> do+            hasError "guidance title must not be empty" errs `shouldBe` True+            hasError "guidance body must not be empty" errs `shouldBe` True+          other -> expectationFailure ("Expected ValidationError, got: " <> show other)++    it "rejects guidance conditions that reference undeclared variables" $ do+      withSystemTempDirectory "seihou-prompt" $ \tmpDir -> do+        let bad =+              withAgentPromptGuidance+                [PromptGuidance "Missing" "This references an unknown value." (Just (ExprIsSet "repo.kind"))]+                goodAgentPrompt+        result <- validateAgentPrompt tmpDir bad+        case result of+          Left (ValidationError _ errs) ->+            hasError "guidance 'Missing' references undeclared variable: repo.kind" errs `shouldBe` True+          other -> expectationFailure ("Expected ValidationError, got: " <> show other)++    it "checks referenced prompt files under files/" $ do+      withSystemTempDirectory "seihou-prompt" $ \tmpDir -> do+        let bad =+              withAgentPromptFiles+                [BlueprintFile {src = "missing.md", description = Nothing}]+                goodAgentPrompt+        result <- validateAgentPrompt tmpDir bad+        case result of+          Left (ValidationError _ errs) ->+            hasError "prompt file not found" errs `shouldBe` True+          other -> expectationFailure ("Expected ValidationError, got: " <> show other)++  describe "prompt discovery" $ do+    it "finds a prompt when only prompt.dhall is present" $ do+      withSystemTempDirectory "seihou-prompt" $ \tmpDir -> do+        let promptDir = tmpDir </> "review-changes"+        createDirectoryIfMissing True promptDir+        writeFile (promptDir </> "prompt.dhall") (samplePromptDhall "review-changes")+        result <- discoverRunnable [tmpDir] "review-changes"+        case result of+          Right (RunnableAgentPrompt p dir) -> do+            p.name `shouldBe` "review-changes"+            dir `shouldBe` promptDir+          other -> expectationFailure ("Expected RunnableAgentPrompt, got: " <> show other)++    it "tags prompts as KindPrompt during enumeration" $ do+      withSystemTempDirectory "seihou-prompt" $ \tmpDir -> do+        let promptDir = tmpDir </> "review-changes"+        createDirectoryIfMissing True promptDir+        writeFile (promptDir </> "prompt.dhall") (samplePromptDhall "review-changes")+        found <- discoverAllRunnables [tmpDir]+        case found of+          [DiscoveredRunnable {drKind = kind}] -> kind `shouldBe` KindPrompt+          other -> expectationFailure ("Expected one discovered prompt, got: " <> show other)++    it "prefers blueprint.dhall over prompt.dhall in the same directory" $ do+      withSystemTempDirectory "seihou-prompt" $ \tmpDir -> do+        let entryDir = tmpDir </> "ambiguous"+        createDirectoryIfMissing True entryDir+        writeFile (entryDir </> "blueprint.dhall") (sampleBlueprintDhall "ambiguous")+        writeFile (entryDir </> "prompt.dhall") (samplePromptDhall "ambiguous")+        result <- discoverRunnable [tmpDir] "ambiguous"+        case result of+          Right (RunnableBlueprint _ _) -> pure ()+          other -> expectationFailure ("Expected RunnableBlueprint, got: " <> show other)++samplePromptDhall :: T.Text -> String+samplePromptDhall n =+  unlines+    [ "{ name = \"" ++ T.unpack n ++ "\"",+      ", version = Some \"0.1.0\"",+      ", description = Some \"Review local changes\"",+      ", prompt = \"Review the current repository.\"",+      ", vars =",+      "    [] : List",+      "          { name : Text",+      "          , type : Text",+      "          , default : Optional Text",+      "          , description : Optional Text",+      "          , required : Bool",+      "          , validation : Optional Text",+      "          }",+      ", prompts =",+      "    [] : List",+      "          { var : Text",+      "          , text : Text",+      "          , when : Optional Text",+      "          , choices : Optional (List Text)",+      "          }",+      ", commandVars =",+      "    [ { name = \"git.branch\"",+      "      , run = \"git branch --show-current\"",+      "      , workDir = None Text",+      "      , when = None Text",+      "      , trim = True",+      "      , maxBytes = Some 4096",+      "      }",+      "    ]",+      ", guidance =",+      "    [ { title = \"Repository workflow\"",+      "      , body = \"Prefer focused validation commands.\"",+      "      , when = Some \"Eq git.branch main\"",+      "      }",+      "    ]",+      ", files = [] : List { src : Text, description : Optional Text }",+      ", allowedTools = None (List Text)",+      ", tags = [ \"review\" ]",+      ", launch = Some { provider = Some \"codex-cli\", mode = None Text, model = None Text }",+      "}"+    ]++samplePromptDhallWithoutGuidance :: T.Text -> String+samplePromptDhallWithoutGuidance n =+  unlines+    [ "{ name = \"" ++ T.unpack n ++ "\"",+      ", version = Some \"0.1.0\"",+      ", description = Some \"Review local changes\"",+      ", prompt = \"Review the current repository.\"",+      ", vars =",+      "    [] : List",+      "          { name : Text",+      "          , type : Text",+      "          , default : Optional Text",+      "          , description : Optional Text",+      "          , required : Bool",+      "          , validation : Optional Text",+      "          }",+      ", prompts =",+      "    [] : List",+      "          { var : Text",+      "          , text : Text",+      "          , when : Optional Text",+      "          , choices : Optional (List Text)",+      "          }",+      ", commandVars =",+      "    [] : List",+      "          { name : Text",+      "          , run : Text",+      "          , workDir : Optional Text",+      "          , when : Optional Text",+      "          , trim : Bool",+      "          , maxBytes : Optional Natural",+      "          }",+      ", files = [] : List { src : Text, description : Optional Text }",+      ", allowedTools = None (List Text)",+      ", tags = [ \"review\" ]",+      ", launch = None { provider : Optional Text, mode : Optional Text, model : Optional Text }",+      "}"+    ]++sampleBlueprintDhall :: T.Text -> String+sampleBlueprintDhall n =+  unlines+    [ "{ name = \"" ++ T.unpack n ++ "\"",+      ", version = Some \"0.1.0\"",+      ", description = None Text",+      ", prompt = \"hello\"",+      ", vars =",+      "    [] : List",+      "          { name : Text",+      "          , type : Text",+      "          , default : Optional Text",+      "          , description : Optional Text",+      "          , required : Bool",+      "          , validation : Optional Text",+      "          }",+      ", prompts =",+      "    [] : List",+      "          { var : Text",+      "          , text : Text",+      "          , when : Optional Text",+      "          , choices : Optional (List Text)",+      "          }",+      ", baseModules =",+      "    [] : List { module : Text, vars : List { name : Text, value : Text } }",+      ", files =",+      "    [] : List { src : Text, description : Optional Text }",+      ", allowedTools = None (List Text)",+      ", tags = [] : List Text",+      "}"+    ]
+ test/Seihou/Core/BlueprintSpec.hs view
@@ -0,0 +1,344 @@+module Seihou.Core.BlueprintSpec (tests) where++import Data.Map.Strict qualified as Map+import Data.Text qualified as T+import Seihou.Core.Blueprint (validateBlueprintWith)+import Seihou.Core.Module (discoverRunnable)+import Seihou.Core.Types+import Seihou.Dhall.Eval (evalBlueprintFromFile)+import System.Directory (createDirectoryIfMissing, getCurrentDirectory)+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.Core.Blueprint" spec++fixtureDir :: FilePath+fixtureDir = "test/fixtures"++hasError :: T.Text -> [T.Text] -> Bool+hasError needle = any (T.isInfixOf needle)++-- | A well-formed blueprint used as the seed for negative-case tests.+goodBlueprint :: Blueprint+goodBlueprint =+  Blueprint+    "valid-bp"+    (Just "0.1.0")+    (Just "A valid blueprint")+    "Scaffold something for the user."+    [ VarDecl+        { name = "project.name",+          type_ = VTText,+          default_ = Nothing,+          description = Nothing,+          required = True,+          validation = Nothing+        }+    ]+    []+    []+    []+    Nothing+    []++-- | Helpers to update individual 'Blueprint' fields without ambiguous+-- record updates. Several @Blueprint@ fields collide by name with+-- @Module@, @Recipe@, and @Manifest@; positional construction sidesteps+-- the ambiguity once and for all.+withBlueprintName :: ModuleName -> Blueprint -> Blueprint+withBlueprintName n b =+  Blueprint n b.version b.description b.prompt b.vars b.prompts b.baseModules b.files b.allowedTools b.tags++withBlueprintVersion :: Maybe T.Text -> Blueprint -> Blueprint+withBlueprintVersion v b =+  Blueprint b.name v b.description b.prompt b.vars b.prompts b.baseModules b.files b.allowedTools b.tags++withBlueprintPrompt :: T.Text -> Blueprint -> Blueprint+withBlueprintPrompt p b =+  Blueprint b.name b.version b.description p b.vars b.prompts b.baseModules b.files b.allowedTools b.tags++withBlueprintVars :: [VarDecl] -> Blueprint -> Blueprint+withBlueprintVars vs b =+  Blueprint b.name b.version b.description b.prompt vs b.prompts b.baseModules b.files b.allowedTools b.tags++withBlueprintPrompts :: [Prompt] -> Blueprint -> Blueprint+withBlueprintPrompts ps b =+  Blueprint b.name b.version b.description b.prompt b.vars ps b.baseModules b.files b.allowedTools b.tags++withBlueprintBaseModules :: [Dependency] -> Blueprint -> Blueprint+withBlueprintBaseModules ds b =+  Blueprint b.name b.version b.description b.prompt b.vars b.prompts ds b.files b.allowedTools b.tags++withBlueprintFiles :: [BlueprintFile] -> Blueprint -> Blueprint+withBlueprintFiles fs b =+  Blueprint b.name b.version b.description b.prompt b.vars b.prompts b.baseModules fs b.allowedTools b.tags++withBlueprintAllowedTools :: Maybe [T.Text] -> Blueprint -> Blueprint+withBlueprintAllowedTools at b =+  Blueprint b.name b.version b.description b.prompt b.vars b.prompts b.baseModules b.files at b.tags++withBlueprintTags :: [T.Text] -> Blueprint -> Blueprint+withBlueprintTags ts b =+  Blueprint b.name b.version b.description b.prompt b.vars b.prompts b.baseModules b.files b.allowedTools ts++spec :: Spec+spec = do+  describe "evalBlueprintFromFile (sample fixture)" $ do+    it "decodes the sample-blueprint fixture" $ do+      result <- evalBlueprintFromFile (fixtureDir </> "sample-blueprint" </> "blueprint.dhall")+      case result of+        Left err -> expectationFailure ("Expected Right, got Left: " <> show err)+        Right b -> do+          b.name `shouldBe` ModuleName "sample-blueprint"+          b.version `shouldBe` Just "0.1.0"+          b.description `shouldBe` Just "Fixture blueprint for EP-29 tests"+          T.isInfixOf "{{project.name}}" b.prompt `shouldBe` True+          length b.vars `shouldBe` 2+          b.tags `shouldBe` ["demo"]+          b.baseModules `shouldBe` []+          length b.files `shouldBe` 1++  describe "validateBlueprintWith (sample fixture)" $ do+    it "accepts the sample-blueprint fixture" $ do+      cwd <- getCurrentDirectory+      let baseDir = cwd </> "test" </> "fixtures" </> "sample-blueprint"+      Right b <- evalBlueprintFromFile (baseDir </> "blueprint.dhall")+      result <- validateBlueprintWith [] baseDir b+      case result of+        Right b' -> b'.name `shouldBe` "sample-blueprint"+        Left err -> expectationFailure ("Expected Right, got: " <> show err)++  describe "validateBlueprintWith (rule-by-rule)" $ do+    it "rejects an invalid blueprint name" $ do+      withSystemTempDirectory "seihou-test" $ \tmpDir -> do+        let bad = withBlueprintName "Bad_Name" goodBlueprint+        result <- validateBlueprintWith [] tmpDir bad+        case result of+          Left (ValidationError _ errs) ->+            hasError "blueprint name must match" errs `shouldBe` True+          other -> expectationFailure ("Expected ValidationError, got: " <> show other)++    it "rejects an empty version string" $ do+      withSystemTempDirectory "seihou-test" $ \tmpDir -> do+        let bad = withBlueprintVersion (Just "  ") goodBlueprint+        result <- validateBlueprintWith [] tmpDir bad+        case result of+          Left (ValidationError _ errs) ->+            hasError "version, if specified, must not be empty" errs `shouldBe` True+          other -> expectationFailure ("Expected ValidationError, got: " <> show other)++    it "accepts a missing version" $ do+      withSystemTempDirectory "seihou-test" $ \tmpDir -> do+        let bp = withBlueprintVersion Nothing goodBlueprint+        result <- validateBlueprintWith [] tmpDir bp+        case result of+          Right _ -> pure ()+          Left err -> expectationFailure ("Expected Right, got: " <> show err)++    it "rejects an empty prompt" $ do+      withSystemTempDirectory "seihou-test" $ \tmpDir -> do+        let bad = withBlueprintPrompt "   \n  " goodBlueprint+        result <- validateBlueprintWith [] tmpDir bad+        case result of+          Left (ValidationError _ errs) ->+            hasError "prompt must not be empty" errs `shouldBe` True+          other -> expectationFailure ("Expected ValidationError, got: " <> show other)++    it "rejects duplicate variable names" $ do+      withSystemTempDirectory "seihou-test" $ \tmpDir -> do+        let dup =+              VarDecl+                { name = "project.name",+                  type_ = VTBool,+                  default_ = Nothing,+                  description = Nothing,+                  required = False,+                  validation = Nothing+                }+            bad = withBlueprintVars (goodBlueprint.vars ++ [dup]) goodBlueprint+        result <- validateBlueprintWith [] tmpDir bad+        case result of+          Left (ValidationError _ errs) ->+            hasError "duplicate variable name" errs `shouldBe` True+          other -> expectationFailure ("Expected ValidationError, got: " <> show other)++    it "rejects a prompt referencing an undeclared variable" $ do+      withSystemTempDirectory "seihou-test" $ \tmpDir -> do+        let bad =+              withBlueprintPrompts+                [Prompt {var = "undeclared", text = "?", condition = Nothing, choices = Nothing}]+                goodBlueprint+        result <- validateBlueprintWith [] tmpDir bad+        case result of+          Left (ValidationError _ errs) ->+            hasError "prompt references undeclared" errs `shouldBe` True+          other -> expectationFailure ("Expected ValidationError, got: " <> show other)++    it "rejects an empty tag" $ do+      withSystemTempDirectory "seihou-test" $ \tmpDir -> do+        let bad = withBlueprintTags ["ok", "  "] goodBlueprint+        result <- validateBlueprintWith [] tmpDir bad+        case result of+          Left (ValidationError _ errs) ->+            hasError "tag must not be empty" errs `shouldBe` True+          other -> expectationFailure ("Expected ValidationError, got: " <> show other)++    it "rejects an empty allowedTools entry" $ do+      withSystemTempDirectory "seihou-test" $ \tmpDir -> do+        let bad = withBlueprintAllowedTools (Just ["Read", ""]) goodBlueprint+        result <- validateBlueprintWith [] tmpDir bad+        case result of+          Left (ValidationError _ errs) ->+            hasError "allowedTools entry must not be empty" errs `shouldBe` True+          other -> expectationFailure ("Expected ValidationError, got: " <> show other)++    it "rejects a missing referenced file" $ do+      withSystemTempDirectory "seihou-test" $ \tmpDir -> do+        let bad =+              withBlueprintFiles+                [BlueprintFile {src = "missing.md", description = Nothing}]+                goodBlueprint+        result <- validateBlueprintWith [] tmpDir bad+        case result of+          Left (ValidationError _ errs) ->+            hasError "blueprint file not found" errs `shouldBe` True+          other -> expectationFailure ("Expected ValidationError, got: " <> show other)++    it "accepts a referenced file when present on disk" $ do+      withSystemTempDirectory "seihou-test" $ \tmpDir -> do+        createDirectoryIfMissing True (tmpDir </> "files")+        writeFile (tmpDir </> "files" </> "snippet.md") "stub"+        let bp =+              withBlueprintFiles+                [BlueprintFile {src = "snippet.md", description = Nothing}]+                goodBlueprint+        result <- validateBlueprintWith [] tmpDir bp+        case result of+          Right _ -> pure ()+          Left err -> expectationFailure ("Expected Right, got: " <> show err)++    it "rejects a baseModule that does not resolve" $ do+      withSystemTempDirectory "seihou-test" $ \tmpDir -> do+        let bad =+              withBlueprintBaseModules+                [Dependency {depModule = "nope-not-here", depVars = Map.empty}]+                goodBlueprint+        result <- validateBlueprintWith [tmpDir] tmpDir bad+        case result of+          Left (ValidationError _ errs) ->+            hasError "not found in any search path" errs `shouldBe` True+          other -> expectationFailure ("Expected ValidationError, got: " <> show other)++    it "rejects a baseModule that resolves to another blueprint" $ do+      withSystemTempDirectory "seihou-test" $ \tmpDir -> do+        let nestedDir = tmpDir </> "nested-bp"+        createDirectoryIfMissing True nestedDir+        writeFile (nestedDir </> "blueprint.dhall") (sampleBlueprintDhall "nested-bp")+        let bad =+              withBlueprintBaseModules+                [Dependency {depModule = "nested-bp", depVars = Map.empty}]+                goodBlueprint+        result <- validateBlueprintWith [tmpDir] tmpDir bad+        case result of+          Left (ValidationError _ errs) ->+            hasError "resolves to a blueprint" errs `shouldBe` True+          other -> expectationFailure ("Expected ValidationError, got: " <> show other)++  describe "discoverRunnable for blueprints" $ do+    it "finds a blueprint when only blueprint.dhall is present" $ do+      withSystemTempDirectory "seihou-test" $ \tmpDir -> do+        let bpDir = tmpDir </> "only-bp"+        createDirectoryIfMissing True bpDir+        writeFile (bpDir </> "blueprint.dhall") (sampleBlueprintDhall "only-bp")+        result <- discoverRunnable [tmpDir] "only-bp"+        case result of+          Right (RunnableBlueprint b dir) -> do+            b.name `shouldBe` "only-bp"+            dir `shouldBe` bpDir+          other -> expectationFailure ("Expected RunnableBlueprint, got: " <> show other)++    it "prefers module.dhall over blueprint.dhall in the same directory" $ do+      withSystemTempDirectory "seihou-test" $ \tmpDir -> do+        let entryDir = tmpDir </> "ambiguous"+        createDirectoryIfMissing True entryDir+        writeFile (entryDir </> "module.dhall") minimalModuleDhall+        writeFile (entryDir </> "blueprint.dhall") (sampleBlueprintDhall "ambiguous")+        result <- discoverRunnable [tmpDir] "ambiguous"+        case result of+          Right (RunnableModule _ _) -> pure ()+          other -> expectationFailure ("Expected RunnableModule (module wins over blueprint), got: " <> show other)++-- | A minimal module Dhall body for the priority-conflict test.+minimalModuleDhall :: String+minimalModuleDhall =+  unlines+    [ "{ name = \"ambiguous\"",+      ", version = Some \"1.0.0\"",+      ", description = None Text",+      ", vars =",+      "    [] : List",+      "          { name : Text",+      "          , type : Text",+      "          , default : Optional Text",+      "          , description : Optional Text",+      "          , required : Bool",+      "          , validation : Optional Text",+      "          }",+      ", exports = [] : List { var : Text, alias : Optional Text }",+      ", prompts =",+      "    [] : List",+      "          { var : Text",+      "          , text : Text",+      "          , when : Optional Text",+      "          , choices : Optional (List Text)",+      "          }",+      ", steps =",+      "    [] : List",+      "          { strategy : Text",+      "          , src : Text",+      "          , dest : Text",+      "          , when : Optional Text",+      "          , patch : Optional Text",+      "          }",+      ", commands =",+      "    [] : List { run : Text, workDir : Optional Text, when : Optional Text }",+      ", dependencies = [] : List Text",+      "}"+    ]++-- | A minimal blueprint Dhall body parameterised by name.+sampleBlueprintDhall :: T.Text -> String+sampleBlueprintDhall n =+  unlines+    [ "{ name = \"" ++ T.unpack n ++ "\"",+      ", version = Some \"0.1.0\"",+      ", description = None Text",+      ", prompt = \"hello\"",+      ", vars =",+      "    [] : List",+      "          { name : Text",+      "          , type : Text",+      "          , default : Optional Text",+      "          , description : Optional Text",+      "          , required : Bool",+      "          , validation : Optional Text",+      "          }",+      ", prompts =",+      "    [] : List",+      "          { var : Text",+      "          , text : Text",+      "          , when : Optional Text",+      "          , choices : Optional (List Text)",+      "          }",+      ", baseModules =",+      "    [] : List { module : Text, vars : List { name : Text, value : Text } }",+      ", files =",+      "    [] : List { src : Text, description : Optional Text }",+      ", allowedTools = None (List Text)",+      ", tags = [] : List Text",+      "}"+    ]
+ test/Seihou/Core/CommandVarSpec.hs view
@@ -0,0 +1,211 @@+module Seihou.Core.CommandVarSpec (tests) where++import Data.Map.Strict qualified as Map+import Data.Text qualified as T+import Effectful (runPureEff)+import Numeric.Natural (Natural)+import Seihou.Core.CommandVar (planCommandVars, resolveCommandVars)+import Seihou.Core.Types+import Seihou.Effect.ProcessPure (ProcessMock (..), runProcessPure)+import System.Exit (ExitCode (..))+import Test.Hspec+import Test.Tasty+import Test.Tasty.Hspec (testSpec)++tests :: IO TestTree+tests = testSpec "Seihou.Core.CommandVar" spec++textDecl :: VarName -> VarDecl+textDecl name = VarDecl name VTText Nothing Nothing False Nothing++boolDecl :: VarName -> VarDecl+boolDecl name = VarDecl name VTBool Nothing Nothing False Nothing++intDecl :: VarName -> VarDecl+intDecl name = VarDecl name VTInt Nothing Nothing False Nothing++patternDecl :: VarName -> VarDecl+patternDecl name = VarDecl name VTText Nothing Nothing False (Just (ValPattern "[a-z][a-z0-9-]*"))++cmdVar :: VarName -> T.Text -> CommandVar+cmdVar name run =+  CommandVar+    { name = name,+      run = run,+      workDir = Nothing,+      condition = Nothing,+      trim = True,+      maxBytes = Just 4096+    }++withCondition :: Maybe Expr -> CommandVar -> CommandVar+withCondition condition cv =+  CommandVar cv.name cv.run cv.workDir condition cv.trim cv.maxBytes++withTrim :: Bool -> CommandVar -> CommandVar+withTrim trim cv =+  CommandVar cv.name cv.run cv.workDir cv.condition trim cv.maxBytes++withMaxBytes :: Maybe Natural -> CommandVar -> CommandVar+withMaxBytes maxBytes cv =+  CommandVar cv.name cv.run cv.workDir cv.condition cv.trim maxBytes++commandVarName :: CommandVar -> VarName+commandVarName cv = cv.name++commandVarRun :: CommandVar -> T.Text+commandVarRun cv = cv.run++mock :: T.Text -> ExitCode -> T.Text -> T.Text -> ProcessMock+mock run exitCode stdoutText stderrText =+  ProcessMock+    { mockCommand = "sh",+      mockArgs = ["-c", run],+      mockResult = (exitCode, stdoutText, stderrText)+    }++runResolve ::+  [VarDecl] ->+  [CommandVar] ->+  Map.Map VarName ResolvedVar ->+  [ProcessMock] ->+  Either [VarError] (Map.Map VarName ResolvedVar)+runResolve decls commandVars existing mocks =+  runPureEff $+    runProcessPure mocks $+      resolveCommandVars decls commandVars existing++resolved :: VarDecl -> VarValue -> VarSource -> ResolvedVar+resolved decl value source = ResolvedVar {value = value, source = source, decl = decl}++spec :: Spec+spec = do+  describe "planCommandVars" $ do+    it "skips already-resolved variables and false conditions" $ do+      let branchDecl = textDecl "git.branch"+          readyDecl = boolDecl "release.ready"+          existing = Map.singleton "git.branch" (resolved branchDecl (VText "configured") FromLocalConfig)+          bindings = Map.singleton "release.ready" (VBool False)+          planned =+            planCommandVars+              [ cmdVar "git.branch" "git branch --show-current",+                withCondition (Just (ExprIsSet "git.branch")) (cmdVar "release.notes" "git log"),+                withCondition (Just (ExprEq "release.ready" (VBool True))) (cmdVar "release.ready" "echo true")+              ]+              existing+              bindings+      map commandVarName planned `shouldBe` ["release.notes"]++  describe "resolveCommandVars" $ do+    it "resolves text and bool values from command output" $ do+      let branch = cmdVar "git.branch" "git branch --show-current"+          ready = cmdVar "release.ready" "printf true"+          result =+            runResolve+              [textDecl "git.branch", boolDecl "release.ready"]+              [branch, ready]+              Map.empty+              [ mock (commandVarRun branch) ExitSuccess "main\n" "",+                mock (commandVarRun ready) ExitSuccess "true\n" ""+              ]+      case result of+        Right m -> do+          fmap (.value) (Map.lookup "git.branch" m) `shouldBe` Just (VText "main")+          fmap (.value) (Map.lookup "release.ready" m) `shouldBe` Just (VBool True)+          fmap (.source) (Map.lookup "git.branch" m) `shouldBe` Just (FromCommand "git branch --show-current")+        Left errs -> expectationFailure ("Expected Right, got: " <> show errs)++    it "does not override already-resolved config values" $ do+      let decl = textDecl "git.branch"+          existing = Map.singleton "git.branch" (resolved decl (VText "configured") FromLocalConfig)+          branch = cmdVar "git.branch" "git branch --show-current"+          result =+            runResolve+              [decl]+              [branch]+              existing+              [mock (commandVarRun branch) ExitSuccess "main\n" ""]+      result `shouldBe` Right existing++    it "coerces int output using the matching declaration" $ do+      let count = cmdVar "change.count" "git diff --numstat"+          result =+            runResolve+              [intDecl "change.count"]+              [count]+              Map.empty+              [mock (commandVarRun count) ExitSuccess "42\n" ""]+      fmap (fmap (.value) . Map.lookup "change.count") result `shouldBe` Right (Just (VInt 42))++    it "uses a text declaration for command-only prompt variables" $ do+      let branch = cmdVar "git.branch" "git branch --show-current"+          result =+            runResolve+              []+              [branch]+              Map.empty+              [mock (commandVarRun branch) ExitSuccess "main\n" ""]+      fmap (fmap (.value) . Map.lookup "git.branch") result `shouldBe` Right (Just (VText "main"))++    it "preserves untrimmed output when trim is false" $ do+      let branch = withTrim False (cmdVar "git.branch" "git branch --show-current")+          result =+            runResolve+              [textDecl "git.branch"]+              [branch]+              Map.empty+              [mock (commandVarRun branch) ExitSuccess "main\n" ""]+      fmap (fmap (.value) . Map.lookup "git.branch") result `shouldBe` Right (Just (VText "main\n"))++    it "rejects output that exceeds maxBytes" $ do+      let branch = withMaxBytes (Just 3) (cmdVar "git.branch" "git branch --show-current")+          result =+            runResolve+              [textDecl "git.branch"]+              [branch]+              Map.empty+              [mock (commandVarRun branch) ExitSuccess "main\n" ""]+      case result of+        Left [ValidationFailed "git.branch" msg] ->+          msg `shouldSatisfy` T.isInfixOf "exceeds maxBytes"+        other -> expectationFailure ("Expected maxBytes failure, got: " <> show other)++    it "reports non-zero command exits with stderr" $ do+      let branch = cmdVar "git.branch" "git branch --show-current"+          result =+            runResolve+              [textDecl "git.branch"]+              [branch]+              Map.empty+              [mock (commandVarRun branch) (ExitFailure 2) "" "not a git repo\n"]+      case result of+        Left [ValidationFailed "git.branch" msg] -> do+          msg `shouldSatisfy` T.isInfixOf "exit code 2"+          msg `shouldSatisfy` T.isInfixOf "not a git repo"+        other -> expectationFailure ("Expected command failure, got: " <> show other)++    it "skips commands with false conditions" $ do+      let branch =+            withCondition+              (Just (ExprEq "release.ready" (VBool True)))+              (cmdVar "git.branch" "git branch --show-current")+          result =+            runResolve+              [textDecl "git.branch"]+              [branch]+              (Map.singleton "release.ready" (resolved (boolDecl "release.ready") (VBool False) FromDefault))+              [mock (commandVarRun branch) ExitSuccess "main\n" ""]+      fmap (Map.member "git.branch") result `shouldBe` Right False++    it "validates coerced values against declaration validation" $ do+      let branch = cmdVar "git.branch" "git branch --show-current"+          result =+            runResolve+              [patternDecl "git.branch"]+              [branch]+              Map.empty+              [mock (commandVarRun branch) ExitSuccess "Bad_Branch\n" ""]+      case result of+        Left [ValidationFailed "git.branch" msg] ->+          msg `shouldSatisfy` T.isInfixOf "value does not match pattern"+        other -> expectationFailure ("Expected validation failure, got: " <> show other)
+ test/Seihou/Core/ContextSpec.hs view
@@ -0,0 +1,60 @@+module Seihou.Core.ContextSpec (tests) where++import Data.Map.Strict qualified as Map+import Seihou.Core.Context+import Test.Hspec+import Test.Tasty+import Test.Tasty.Hspec (testSpec)++tests :: IO TestTree+tests = testSpec "Seihou.Core.Context" spec++spec :: Spec+spec = do+  describe "resolveContext" $ do+    it "returns CLI flag when provided" $ do+      result <- resolveContext (Just "work") Map.empty+      result `shouldBe` Just "work"++    it "strips whitespace from CLI flag" $ do+      result <- resolveContext (Just "  work  ") Map.empty+      result `shouldBe` Just "work"++    it "ignores empty CLI flag and falls through" $ do+      result <- resolveContext (Just "") Map.empty+      result `shouldBe` Nothing++    it "returns SEIHOU_CONTEXT env var when CLI flag is absent" $ do+      let envVars = Map.singleton "SEIHOU_CONTEXT" "personal"+      result <- resolveContext Nothing envVars+      result `shouldBe` Just "personal"++    it "CLI flag takes precedence over env var" $ do+      let envVars = Map.singleton "SEIHOU_CONTEXT" "personal"+      result <- resolveContext (Just "work") envVars+      result `shouldBe` Just "work"++    it "ignores empty SEIHOU_CONTEXT env var" $ do+      let envVars = Map.singleton "SEIHOU_CONTEXT" ""+      result <- resolveContext Nothing envVars+      result `shouldBe` Nothing++    it "returns Nothing when no source provides a context" $ do+      result <- resolveContext Nothing Map.empty+      result `shouldBe` Nothing++  describe "validateContextName" $ do+    it "accepts a normal context name" $ do+      validateContextName "work" `shouldBe` Nothing++    it "accepts a hyphenated context name" $ do+      validateContextName "my-work" `shouldBe` Nothing++    it "rejects empty context name" $ do+      validateContextName "" `shouldSatisfy` (/= Nothing)++    it "rejects context name containing '..'" $ do+      validateContextName "foo..bar" `shouldSatisfy` (/= Nothing)++    it "rejects context name containing '/'" $ do+      validateContextName "foo/bar" `shouldSatisfy` (/= Nothing)
+ test/Seihou/Core/ExprSpec.hs view
@@ -0,0 +1,177 @@+module Seihou.Core.ExprSpec (tests) where++import Data.Map.Strict qualified as Map+import Seihou.Core.Expr (evalExpr, exprRefs, parseExpr)+import Seihou.Core.Types+import Test.Hspec+import Test.Tasty+import Test.Tasty.Hspec (testSpec)++tests :: IO TestTree+tests = testSpec "Seihou.Core.Expr" spec++spec :: Spec+spec = do+  describe "parseExpr" $ do+    it "parses true literal" $ do+      parseExpr "true" `shouldBe` Right (ExprLit True)++    it "parses false literal" $ do+      parseExpr "false" `shouldBe` Right (ExprLit False)++    it "parses IsSet atom" $ do+      parseExpr "IsSet license" `shouldBe` Right (ExprIsSet "license")++    it "parses IsSet with dotted var name" $ do+      parseExpr "IsSet project.name" `shouldBe` Right (ExprIsSet "project.name")++    it "parses Eq with quoted value" $ do+      parseExpr "Eq license \"MIT\""+        `shouldBe` Right (ExprEq "license" (VText "MIT"))++    it "parses Eq with bare word value" $ do+      parseExpr "Eq license MIT"+        `shouldBe` Right (ExprEq "license" (VText "MIT"))++    it "parses Eq with bare word true as VBool" $ do+      parseExpr "Eq enabled true"+        `shouldBe` Right (ExprEq "enabled" (VBool True))++    it "parses Eq with bare word false as VBool" $ do+      parseExpr "Eq enabled false"+        `shouldBe` Right (ExprEq "enabled" (VBool False))++    it "parses Eq with all-digit bare word as VInt" $ do+      parseExpr "Eq count 3"+        `shouldBe` Right (ExprEq "count" (VInt 3))++    it "parses Eq with negative integer bare word as VInt" $ do+      parseExpr "Eq offset -5"+        `shouldBe` Right (ExprEq "offset" (VInt (-5)))++    it "parses Eq with quoted digits as VText (not VInt)" $ do+      parseExpr "Eq count \"3\""+        `shouldBe` Right (ExprEq "count" (VText "3"))++    it "parses && expression" $ do+      parseExpr "IsSet a && IsSet b"+        `shouldBe` Right (ExprAnd (ExprIsSet "a") (ExprIsSet "b"))++    it "parses || expression" $ do+      parseExpr "IsSet a || IsSet b"+        `shouldBe` Right (ExprOr (ExprIsSet "a") (ExprIsSet "b"))++    it "parses ! negation" $ do+      parseExpr "!true"+        `shouldBe` Right (ExprNot (ExprLit True))++    it "parses negation with space" $ do+      parseExpr "! false"+        `shouldBe` Right (ExprNot (ExprLit False))++    it "parses parenthesized expression" $ do+      parseExpr "(true)"+        `shouldBe` Right (ExprLit True)++    it "respects operator precedence: && binds tighter than ||" $ do+      parseExpr "IsSet a && IsSet b || IsSet c"+        `shouldBe` Right (ExprOr (ExprAnd (ExprIsSet "a") (ExprIsSet "b")) (ExprIsSet "c"))++    it "parentheses override precedence" $ do+      parseExpr "IsSet a && (IsSet b || IsSet c)"+        `shouldBe` Right (ExprAnd (ExprIsSet "a") (ExprOr (ExprIsSet "b") (ExprIsSet "c")))++    it "parses compound expression from design doc" $ do+      parseExpr "IsSet license && Eq license \"MIT\""+        `shouldBe` Right+          ( ExprAnd+              (ExprIsSet "license")+              (ExprEq "license" (VText "MIT"))+          )++    it "rejects empty expression" $ do+      parseExpr "" `shouldBe` Left "empty expression"++    it "rejects malformed expression" $ do+      case parseExpr "@#$" of+        Left _ -> pure ()+        Right r -> expectationFailure ("Expected parse error, got: " <> show r)++    it "handles whitespace" $ do+      parseExpr "  true  " `shouldBe` Right (ExprLit True)++  describe "evalExpr" $ do+    let vars =+          Map.fromList+            [ (VarName "license", VText "MIT"),+              (VarName "project.name", VText "my-app"),+              (VarName "enabled", VBool True)+            ]++    it "evaluates ExprLit True" $ do+      evalExpr vars (ExprLit True) `shouldBe` True++    it "evaluates ExprLit False" $ do+      evalExpr vars (ExprLit False) `shouldBe` False++    it "evaluates ExprIsSet for present variable" $ do+      evalExpr vars (ExprIsSet "license") `shouldBe` True++    it "evaluates ExprIsSet for absent variable" $ do+      evalExpr vars (ExprIsSet "missing") `shouldBe` False++    it "evaluates ExprEq when values match" $ do+      evalExpr vars (ExprEq "license" (VText "MIT")) `shouldBe` True++    it "evaluates ExprEq when values differ" $ do+      evalExpr vars (ExprEq "license" (VText "BSD")) `shouldBe` False++    it "evaluates ExprEq with VBool True" $ do+      evalExpr vars (ExprEq "enabled" (VBool True)) `shouldBe` True++    it "evaluates ExprEq with VBool False against VBool True" $ do+      evalExpr vars (ExprEq "enabled" (VBool False)) `shouldBe` False++    it "evaluates a parsed int Eq against a VInt binding" $ do+      let intVars = Map.fromList [(VarName "count", VInt 3)]+      case parseExpr "Eq count 3" of+        Right expr -> evalExpr intVars expr `shouldBe` True+        Left err -> expectationFailure ("Expected parse, got: " <> show err)++    it "evaluates ExprNot" $ do+      evalExpr vars (ExprNot (ExprLit True)) `shouldBe` False+      evalExpr vars (ExprNot (ExprLit False)) `shouldBe` True++    it "evaluates ExprAnd" $ do+      evalExpr vars (ExprAnd (ExprLit True) (ExprLit True)) `shouldBe` True+      evalExpr vars (ExprAnd (ExprLit True) (ExprLit False)) `shouldBe` False++    it "evaluates ExprOr" $ do+      evalExpr vars (ExprOr (ExprLit True) (ExprLit False)) `shouldBe` True+      evalExpr vars (ExprOr (ExprLit False) (ExprLit False)) `shouldBe` False++    it "evaluates compound expression from design doc" $ do+      let expr = ExprAnd (ExprIsSet "license") (ExprEq "license" (VText "MIT"))+      evalExpr vars expr `shouldBe` True+      evalExpr Map.empty expr `shouldBe` False++  describe "exprRefs" $ do+    it "returns the compared literal for Eq with a bareword bool" $ do+      exprRefs (ExprEq "x" (VBool True)) `shouldBe` [("x", Just (VBool True))]++    it "returns the compared literal for Eq with a quoted string" $ do+      exprRefs (ExprEq "x" (VText "true")) `shouldBe` [("x", Just (VText "true"))]++    it "returns a Nothing literal for IsSet" $ do+      exprRefs (ExprIsSet "y") `shouldBe` [("y", Nothing)]++    it "collects refs across && with mixed atoms" $ do+      exprRefs (ExprAnd (ExprIsSet "y") (ExprEq "z" (VInt 1)))+        `shouldBe` [("y", Nothing), ("z", Just (VInt 1))]++    it "recurses through Or and Not" $ do+      exprRefs (ExprOr (ExprNot (ExprIsSet "a")) (ExprEq "b" (VBool False)))+        `shouldBe` [("a", Nothing), ("b", Just (VBool False))]++    it "returns nothing for a literal" $ do+      exprRefs (ExprLit True) `shouldBe` []
+ test/Seihou/Core/InstallSpec.hs view
@@ -0,0 +1,31 @@+module Seihou.Core.InstallSpec (tests) where++import Seihou.Core.Install (parseModuleName)+import Test.Hspec+import Test.Tasty+import Test.Tasty.Hspec (testSpec)++tests :: IO TestTree+tests = testSpec "Seihou.Core.Install" spec++spec :: Spec+spec = do+  describe "parseModuleName" $ do+    it "extracts repo name from HTTPS URL with .git suffix" $+      parseModuleName "https://github.com/user/my-module.git" `shouldBe` "my-module"++    it "extracts repo name from HTTPS URL without .git suffix" $+      parseModuleName "https://github.com/user/my-module" `shouldBe` "my-module"++    it "returns a bare name unchanged" $+      parseModuleName "my-local-module" `shouldBe` "my-local-module"++    it "extracts repo name from SSH-style URL" $+      -- SSH URLs use : before user, so splitOn "/" takes "user:repo" or similar.+      -- The current implementation splits on "/" so "git@github.com:user/repo.git"+      -- splits to ["git@github.com:user", "repo.git"] and last segment is "repo".+      parseModuleName "git@github.com:user/repo.git" `shouldBe` "repo"++    it "handles URL with trailing slash" $+      -- Trailing slash produces an empty last segment; last returns ""+      parseModuleName "https://github.com/user/my-module/" `shouldBe` ""
+ test/Seihou/Core/ListSpec.hs view
@@ -0,0 +1,85 @@+module Seihou.Core.ListSpec (tests) where++import Data.Text qualified as T+import Seihou.Core.Module (DiscoveredModule (..), ModuleSource (..), discoverAllModules)+import Seihou.Core.Types (ModuleLoadError (..))+import System.Directory (createDirectoryIfMissing)+import System.FilePath ((</>))+import System.IO.Temp (withSystemTempDirectory)+import Test.Hspec+import Test.Tasty+import Test.Tasty.Hspec (testSpec)++tests :: IO TestTree+tests = testSpec "Seihou.Core.Module.discoverAllModules" spec++-- | Write a minimal valid module.dhall that the Dhall evaluator can parse.+writeMinimalModule :: FilePath -> String -> String -> IO ()+writeMinimalModule baseDir name desc = do+  let modDir = baseDir </> name+  createDirectoryIfMissing True (modDir </> "files")+  writeFile+    (modDir </> "module.dhall")+    ( "{ name = \""+        ++ name+        ++ "\", version = None Text, description = Some \""+        ++ desc+        ++ "\", vars = [] : List { name : Text, type : Text, default : Optional Text, description : Optional Text, required : Bool, validation : Optional Text }, exports = [] : List { var : Text, as : Optional Text }, prompts = [] : List { var : Text, text : Text, when : Optional Text, choices : Optional (List Text) }, steps = [] : List { strategy : Text, src : Text, dest : Text, when : Optional Text, patch : Optional Text }, commands = [] : List { run : Text, workDir : Optional Text }, dependencies = [] : List Text, removal = None { steps : List { action : Text, dest : Text, src : Optional Text }, commands : List { run : Text, workDir : Optional Text, when : Optional Text } } }"+    )++spec :: Spec+spec = do+  describe "discoverAllModules" $ do+    it "returns empty list when no search paths have modules" $ do+      withSystemTempDirectory "seihou-list-test" $ \tmp -> do+        let paths = [tmp </> "project", tmp </> "user", tmp </> "installed"]+        result <- discoverAllModules paths+        length result `shouldBe` 0++    it "discovers modules in a search path" $ do+      withSystemTempDirectory "seihou-list-test" $ \tmp -> do+        let userDir = tmp </> "user"+        createDirectoryIfMissing True userDir+        writeMinimalModule userDir "my-mod" "A test module"+        let paths = [tmp </> "project", userDir, tmp </> "installed"]+        result <- discoverAllModules paths+        length result `shouldBe` 1+        (head result).discoveredSource `shouldBe` SourceUser++    it "tags sources correctly across paths" $ do+      withSystemTempDirectory "seihou-list-test" $ \tmp -> do+        let projectDir = tmp </> "project"+            installedDir = tmp </> "installed"+        createDirectoryIfMissing True projectDir+        createDirectoryIfMissing True installedDir+        writeMinimalModule projectDir "mod-a" "Project module"+        writeMinimalModule installedDir "mod-b" "Installed module"+        let paths = [projectDir, tmp </> "user", installedDir]+        result <- discoverAllModules paths+        length result `shouldBe` 2+        let srcs = map (.discoveredSource) result+        SourceProject `elem` srcs `shouldBe` True+        SourceInstalled `elem` srcs `shouldBe` True++    it "captures load errors for broken modules" $ do+      withSystemTempDirectory "seihou-list-test" $ \tmp -> do+        let userDir = tmp </> "user"+            brokenDir = userDir </> "broken"+        createDirectoryIfMissing True brokenDir+        writeFile (brokenDir </> "module.dhall") "this is not valid dhall"+        let paths = [tmp </> "project", userDir, tmp </> "installed"]+        result <- discoverAllModules paths+        length result `shouldBe` 1+        case (head result).discoveredResult of+          Left _ -> pure ()+          Right _ -> expectationFailure "Expected Left for broken module"++    it "skips directories without module.dhall" $ do+      withSystemTempDirectory "seihou-list-test" $ \tmp -> do+        let userDir = tmp </> "user"+            emptyDir = userDir </> "not-a-module"+        createDirectoryIfMissing True emptyDir+        writeMinimalModule userDir "real-mod" "Real module"+        let paths = [tmp </> "project", userDir, tmp </> "installed"]+        result <- discoverAllModules paths+        length result `shouldBe` 1
+ test/Seihou/Core/MigrationSpec.hs view
@@ -0,0 +1,165 @@+module Seihou.Core.MigrationSpec (tests) where++import Data.Text (Text)+import Seihou.Core.Migration+  ( Migration (..),+    MigrationOp (..),+    MigrationPlan (..),+    MigrationPlanError (..),+    planMigrationChain,+  )+import Seihou.Core.Version (Version, parseVersion)+import Test.Hspec+import Test.Tasty+import Test.Tasty.Hspec (testSpec)++tests :: IO TestTree+tests = testSpec "Seihou.Core.Migration" spec++spec :: Spec+spec = do+  describe "planMigrationChain (window walker)" $ do+    it "returns Nothing when installed equals target" $ do+      let r = planMigrationChain "demo" [] (mkV "1.0.0") (mkV "1.0.0")+      r `shouldBe` Right Nothing++    it "rejects a downgrade with MigrationDowngradeNotSupported" $ do+      let r = planMigrationChain "demo" [] (mkV "2.0.0") (mkV "1.0.0")+      r `shouldBe` Left (MigrationDowngradeNotSupported (mkV "2.0.0") (mkV "1.0.0"))++    it "builds a single-edge plan whose target equals the edge's `to`" $ do+      let m = Migration {from = "1.0.0", to = "2.0.0", ops = [DeleteFile {path = "a"}]}+          r = planMigrationChain "demo" [m] (mkV "1.0.0") (mkV "2.0.0")+      case r of+        Right (Just plan) -> do+          plan.planModule `shouldBe` "demo"+          plan.planFrom `shouldBe` mkV "1.0.0"+          plan.planTo `shouldBe` mkV "2.0.0"+          plan.planSteps `shouldBe` [m]+        other -> expectationFailure ("Expected Right (Just ...), got: " <> show other)++    it "builds a two-edge plan in order regardless of declaration order" $ do+      let m1 = Migration "1.0.0" "2.0.0" [DeleteFile "a"]+          m2 = Migration "2.0.0" "3.0.0" [DeleteFile "b"]+          r = planMigrationChain "demo" [m2, m1] (mkV "1.0.0") (mkV "3.0.0")+      case r of+        Right (Just plan) -> do+          plan.planSteps `shouldBe` [m1, m2]+          plan.planTo `shouldBe` mkV "3.0.0"+        other -> expectationFailure ("Expected Right (Just ...), got: " <> show other)++    -- Live-tree master-plan fixture (manifest=0.1.0, target=0.3.0,+    -- declared [0.1.0 -> 0.2.0]). The chain reaches 0.2.0 via ops; the+    -- manifest still advances to the supplied target 0.3.0.+    it "yields a partial-cover plan for the EP-5 master-plan fixture" $ do+      let m = Migration "0.1.0" "0.2.0" []+          r = planMigrationChain "demo" [m] (mkV "0.1.0") (mkV "0.3.0")+      case r of+        Right (Just plan) -> do+          plan.planSteps `shouldBe` [m]+          plan.planFrom `shouldBe` mkV "0.1.0"+          plan.planTo `shouldBe` mkV "0.3.0"+        other -> expectationFailure ("Expected Right (Just ...), got: " <> show other)++    it "yields an empty-steps plan when no declared migration falls in the window" $ do+      let r = planMigrationChain "demo" [] (mkV "0.1.3") (mkV "0.3.0")+      case r of+        Right (Just plan) -> do+          plan.planSteps `shouldBe` []+          plan.planFrom `shouldBe` mkV "0.1.3"+          plan.planTo `shouldBe` mkV "0.3.0"+        other -> expectationFailure ("Expected Right (Just ...), got: " <> show other)++    it "reports MigrationVersionUnparseable when a from string is malformed" $ do+      let m = Migration "not-a-version" "2.0.0" []+          r = planMigrationChain "demo" [m] (mkV "1.0.0") (mkV "2.0.0")+      r `shouldBe` Left (MigrationVersionUnparseable "not-a-version")++    it "reports MigrationVersionUnparseable when a to string is malformed" $ do+      let m = Migration "1.0.0" "" []+          r = planMigrationChain "demo" [m] (mkV "1.0.0") (mkV "2.0.0")+      r `shouldBe` Left (MigrationVersionUnparseable "")++    it "rejects two edges sharing the same from with MigrationDuplicateEdge" $ do+      let m1 = Migration "1.0.0" "2.0.0" []+          m2 = Migration "1.0.0" "1.5.0" []+          r = planMigrationChain "demo" [m1, m2] (mkV "1.0.0") (mkV "2.0.0")+      case r of+        Left (MigrationDuplicateEdge fromV _) -> fromV `shouldBe` mkV "1.0.0"+        other -> expectationFailure ("Expected MigrationDuplicateEdge, got: " <> show other)++    it "ignores migrations whose from precedes the installed version" $ do+      -- An old 0.5.0 → 1.0.0 migration is irrelevant when installed is 1.0.0.+      let stale = Migration "0.5.0" "1.0.0" []+          live = Migration "1.0.0" "2.0.0" [DeleteFile "x"]+          r = planMigrationChain "demo" [stale, live] (mkV "1.0.0") (mkV "2.0.0")+      case r of+        Right (Just plan) -> do+          plan.planSteps `shouldBe` [live]+          plan.planTo `shouldBe` mkV "2.0.0"+        other -> expectationFailure ("Expected Right (Just ...), got: " <> show other)++    it "treats version equality with trailing zeros consistently" $ do+      -- `mkV "1.0"` and `mkV "1.0.0"` compare equal; planner should treat+      -- them as no-op.+      let r = planMigrationChain "demo" [] (mkV "1.0") (mkV "1.0.0")+      r `shouldBe` Right Nothing++    -- ----------------------------------------------------------------+    -- New EP-35 contract pins+    -- ----------------------------------------------------------------++    it "user's two-component fixture: 0.2 / 0.6 with [{0.2→0.3}, {0.5→0.6}] yields both edges" $ do+      let early = Migration "0.2" "0.3" [DeleteFile "v2"]+          late = Migration "0.5" "0.6" [DeleteFile "v5"]+          r = planMigrationChain "foo" [early, late] (mkV "0.2") (mkV "0.6")+      case r of+        Right (Just plan) -> do+          plan.planFrom `shouldBe` mkV "0.2"+          plan.planTo `shouldBe` mkV "0.6"+          plan.planSteps `shouldBe` [early, late]+        other -> expectationFailure ("Expected Right (Just ...), got: " <> show other)++    it "skips migrations that overshoot the supplied target" $ do+      let m = Migration "0.5" "1.0" []+          r = planMigrationChain "demo" [m] (mkV "0.4") (mkV "0.6")+      case r of+        Right (Just plan) -> do+          plan.planSteps `shouldBe` []+          plan.planTo `shouldBe` mkV "0.6"+        other -> expectationFailure ("Expected Right (Just ...), got: " <> show other)++    it "skips overlapping migrations once the cursor has advanced past them" $ do+      let big = Migration "0.2" "0.5" [DeleteFile "a"]+          small = Migration "0.3" "0.4" [DeleteFile "b"]+          r = planMigrationChain "demo" [big, small] (mkV "0.2") (mkV "0.5")+      case r of+        Right (Just plan) ->+          plan.planSteps `shouldBe` [big]+        other -> expectationFailure ("Expected Right (Just ...), got: " <> show other)++    it "empty migrations list with installed != target yields empty-steps plan with target" $ do+      let r = planMigrationChain "demo" [] (mkV "0.1") (mkV "0.3")+      case r of+        Right (Just plan) -> do+          plan.planSteps `shouldBe` []+          plan.planFrom `shouldBe` mkV "0.1"+          plan.planTo `shouldBe` mkV "0.3"+        other -> expectationFailure ("Expected Right (Just ...), got: " <> show other)++    it "edges with `to == target` are picked" $ do+      let m = Migration "0.2" "0.3" [DeleteFile "x"]+          r = planMigrationChain "demo" [m] (mkV "0.2") (mkV "0.3")+      case r of+        Right (Just plan) ->+          plan.planSteps `shouldBe` [m]+        other -> expectationFailure ("Expected Right (Just ...), got: " <> show other)++-- ---------------------------------------------------------------------------+-- Helpers+-- ---------------------------------------------------------------------------++mkV :: Text -> Version+mkV t = case parseVersion t of+  Just ver -> ver+  Nothing -> error ("MigrationSpec.mkV: bad version literal " <> show t)
+ test/Seihou/Core/ModuleSpec.hs view
@@ -0,0 +1,276 @@+module Seihou.Core.ModuleSpec (tests) where++import Data.Text qualified as T+import Seihou.Core.Module (discoverModule, loadModule, validateModule)+import Seihou.Core.Types+import System.Directory (createDirectoryIfMissing, getCurrentDirectory)+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.Core.Module" spec++-- | A well-formed module for pure validation tests.+goodModule :: Module+goodModule =+  Module+    { name = "test-module",+      version = Just "1.0.0",+      description = Just "A test module",+      vars =+        [ VarDecl+            { name = "project.name",+              type_ = VTText,+              default_ = Nothing,+              description = Just "Project name",+              required = True,+              validation = Nothing+            }+        ],+      exports = [VarExport {var = "project.name", alias = Nothing}],+      prompts = [Prompt {var = "project.name", text = "Name?", condition = Nothing, choices = Nothing}],+      steps =+        [ Step+            { strategy = Template,+              src = "README.md.tpl",+              dest = "README.md",+              condition = Nothing,+              patch = Nothing+            }+        ],+      commands = [],+      dependencies = [],+      removal = Nothing,+      migrations = []+    }++-- | Helpers to update Module fields without ambiguous record updates.+withModuleName :: ModuleName -> Module -> Module+withModuleName n m = Module n m.version m.description m.vars m.exports m.prompts m.steps m.commands m.dependencies m.removal m.migrations++withModuleVars :: [VarDecl] -> Module -> Module+withModuleVars v m = Module m.name m.version m.description v m.exports m.prompts m.steps m.commands m.dependencies m.removal m.migrations++withModulePrompts :: [Prompt] -> Module -> Module+withModulePrompts p m = Module m.name m.version m.description m.vars m.exports p m.steps m.commands m.dependencies m.removal m.migrations++hasError :: T.Text -> [T.Text] -> Bool+hasError needle = any (T.isInfixOf needle)++spec :: Spec+spec = do+  describe "discoverModule" $ do+    it "finds a module in the search path" $ do+      cwd <- getCurrentDirectory+      let searchPaths = [cwd </> "test" </> "fixtures"]+      result <- discoverModule searchPaths "haskell-base"+      case result of+        Right path -> path `shouldBe` (cwd </> "test" </> "fixtures" </> "haskell-base")+        Left err -> expectationFailure ("Expected Right, got Left: " <> show err)++    it "returns ModuleNotFound when module does not exist" $ do+      result <- discoverModule ["/nonexistent/path"] "no-such-module"+      case result of+        Left (ModuleNotFound name paths) -> do+          name.unModuleName `shouldBe` "no-such-module"+          paths `shouldBe` ["/nonexistent/path"]+        Left other -> expectationFailure ("Expected ModuleNotFound, got: " <> show other)+        Right _ -> expectationFailure "Expected Left, got Right"++    it "searches paths in order and returns the first match" $ do+      withSystemTempDirectory "seihou-test" $ \tmpDir -> do+        let dir1 = tmpDir </> "first"+        let dir2 = tmpDir </> "second"+        createDirectoryIfMissing True (dir1 </> "my-mod")+        createDirectoryIfMissing True (dir2 </> "my-mod")+        writeFile (dir1 </> "my-mod" </> "module.dhall") "{ name = \"my-mod\" }"+        writeFile (dir2 </> "my-mod" </> "module.dhall") "{ name = \"my-mod\" }"+        result <- discoverModule [dir1, dir2] "my-mod"+        case result of+          Right path -> path `shouldBe` (dir1 </> "my-mod")+          Left err -> expectationFailure ("Expected Right, got: " <> show err)++  describe "validateModule" $ do+    it "passes a well-formed module" $ do+      withSystemTempDirectory "seihou-test" $ \tmpDir -> do+        createDirectoryIfMissing True (tmpDir </> "files")+        writeFile (tmpDir </> "files" </> "README.md.tpl") "stub"+        result <- validateModule tmpDir goodModule+        case result of+          Right m -> m.name `shouldBe` "test-module"+          Left err -> expectationFailure ("Expected Right, got: " <> show err)++    it "rejects a bad module name" $ do+      withSystemTempDirectory "seihou-test" $ \tmpDir -> do+        createDirectoryIfMissing True (tmpDir </> "files")+        writeFile (tmpDir </> "files" </> "README.md.tpl") "stub"+        let bad = withModuleName "BadName" goodModule+        result <- validateModule tmpDir bad+        case result of+          Left (ValidationError _ errs) ->+            hasError "module name must match" errs `shouldBe` True+          Left other -> expectationFailure ("Expected ValidationError, got: " <> show other)+          Right _ -> expectationFailure "Expected validation failure"++    it "rejects duplicate variable names" $ do+      withSystemTempDirectory "seihou-test" $ \tmpDir -> do+        createDirectoryIfMissing True (tmpDir </> "files")+        writeFile (tmpDir </> "files" </> "README.md.tpl") "stub"+        let dup =+              withModuleVars+                [ VarDecl "x" VTText Nothing Nothing True Nothing,+                  VarDecl "x" VTBool Nothing Nothing False Nothing+                ]+                goodModule+        result <- validateModule tmpDir dup+        case result of+          Left (ValidationError _ errs) ->+            hasError "duplicate variable name" errs `shouldBe` True+          Left other -> expectationFailure ("Expected ValidationError, got: " <> show other)+          Right _ -> expectationFailure "Expected validation failure"++    it "rejects prompt referencing undeclared variable" $ do+      withSystemTempDirectory "seihou-test" $ \tmpDir -> do+        createDirectoryIfMissing True (tmpDir </> "files")+        writeFile (tmpDir </> "files" </> "README.md.tpl") "stub"+        let bad =+              withModulePrompts+                [Prompt {var = "nonexistent", text = "?", condition = Nothing, choices = Nothing}]+                goodModule+        result <- validateModule tmpDir bad+        case result of+          Left (ValidationError _ errs) ->+            hasError "prompt references undeclared" errs `shouldBe` True+          Left other -> expectationFailure ("Expected ValidationError, got: " <> show other)+          Right _ -> expectationFailure "Expected validation failure"++    it "rejects missing source file" $ do+      withSystemTempDirectory "seihou-test" $ \tmpDir -> do+        result <- validateModule tmpDir goodModule+        case result of+          Left (ValidationError _ errs) ->+            hasError "step source file not found" errs `shouldBe` True+          Left other -> expectationFailure ("Expected ValidationError, got: " <> show other)+          Right _ -> expectationFailure "Expected validation failure"++    it "rejects export referencing undeclared variable" $ do+      withSystemTempDirectory "seihou-test" $ \tmpDir -> do+        createDirectoryIfMissing True (tmpDir </> "files")+        writeFile (tmpDir </> "files" </> "README.md.tpl") "stub"+        let bad =+              goodModule+                { exports = [VarExport {var = "nonexistent", alias = Nothing}]+                }+        result <- validateModule tmpDir bad+        case result of+          Left (ValidationError _ errs) ->+            hasError "export references undeclared" errs `shouldBe` True+          Left other -> expectationFailure ("Expected ValidationError, got: " <> show other)+          Right _ -> expectationFailure "Expected validation failure"++    it "rejects unsafe destination path with .." $ do+      withSystemTempDirectory "seihou-test" $ \tmpDir -> do+        createDirectoryIfMissing True (tmpDir </> "files")+        writeFile (tmpDir </> "files" </> "README.md.tpl") "stub"+        let bad =+              goodModule+                { steps =+                    [Step Template "README.md.tpl" "../etc/passwd" Nothing Nothing]+                }+        result <- validateModule tmpDir bad+        case result of+          Left (ValidationError _ errs) ->+            hasError "must not contain '..'" errs `shouldBe` True+          Left other -> expectationFailure ("Expected ValidationError, got: " <> show other)+          Right _ -> expectationFailure "Expected validation failure"++    it "rejects absolute destination path" $ do+      withSystemTempDirectory "seihou-test" $ \tmpDir -> do+        createDirectoryIfMissing True (tmpDir </> "files")+        writeFile (tmpDir </> "files" </> "README.md.tpl") "stub"+        let bad =+              goodModule+                { steps =+                    [Step Template "README.md.tpl" "/etc/passwd" Nothing Nothing]+                }+        result <- validateModule tmpDir bad+        case result of+          Left (ValidationError _ errs) ->+            hasError "must be relative" errs `shouldBe` True+          Left other -> expectationFailure ("Expected ValidationError, got: " <> show other)+          Right _ -> expectationFailure "Expected validation failure"++    it "allows dots inside destination filenames" $ do+      withSystemTempDirectory "seihou-test" $ \tmpDir -> do+        createDirectoryIfMissing True (tmpDir </> "files")+        writeFile (tmpDir </> "files" </> "README.md.tpl") "stub"+        let dotted =+              goodModule+                { steps =+                    [Step Template "README.md.tpl" "docs/README.v2.md" Nothing Nothing]+                }+        result <- validateModule tmpDir dotted+        case result of+          Right m -> m.name `shouldBe` "test-module"+          Left err -> expectationFailure ("Expected Right, got: " <> show err)++    it "rejects destination referencing undeclared variable" $ do+      withSystemTempDirectory "seihou-test" $ \tmpDir -> do+        createDirectoryIfMissing True (tmpDir </> "files")+        writeFile (tmpDir </> "files" </> "README.md.tpl") "stub"+        let bad =+              goodModule+                { steps =+                    [Step Template "README.md.tpl" "src/{{unknown}}/Main.hs" Nothing Nothing]+                }+        result <- validateModule tmpDir bad+        case result of+          Left (ValidationError _ errs) ->+            hasError "destination references undeclared" errs `shouldBe` True+          Left other -> expectationFailure ("Expected ValidationError, got: " <> show other)+          Right _ -> expectationFailure "Expected validation failure"++    it "collects multiple errors at once" $ do+      withSystemTempDirectory "seihou-test" $ \tmpDir -> do+        let bad =+              Module+                { name = "BadName",+                  version = Nothing,+                  description = Nothing,+                  vars = [],+                  exports = [VarExport {var = "missing", alias = Nothing}],+                  prompts = [Prompt {var = "missing", text = "?", condition = Nothing, choices = Nothing}],+                  steps = [Step Template "nonexistent.tpl" "/bad/dest" Nothing Nothing],+                  commands = [],+                  dependencies = [],+                  removal = Nothing,+                  migrations = []+                }+        result <- validateModule tmpDir bad+        case result of+          Left (ValidationError _ errs) ->+            length errs `shouldSatisfy` (>= 4)+          Left other -> expectationFailure ("Expected ValidationError, got: " <> show other)+          Right _ -> expectationFailure "Expected validation failure"++  describe "loadModule" $ do+    it "loads the haskell-base fixture end-to-end" $ do+      cwd <- getCurrentDirectory+      let searchPaths = [cwd </> "test" </> "fixtures"]+      result <- loadModule searchPaths "haskell-base"+      case result of+        Right m -> do+          m.name `shouldBe` "haskell-base"+          length (m.vars) `shouldBe` 3+          length (m.steps) `shouldBe` 5+        Left err -> expectationFailure ("Expected Right, got Left: " <> show err)++    it "returns ModuleNotFound for nonexistent module" $ do+      result <- loadModule ["/nonexistent"] "no-such-module"+      case result of+        Left (ModuleNotFound _ _) -> pure ()+        Left other -> expectationFailure ("Expected ModuleNotFound, got: " <> show other)+        Right _ -> expectationFailure "Expected Left, got Right"
+ test/Seihou/Core/RecipeSpec.hs view
@@ -0,0 +1,116 @@+module Seihou.Core.RecipeSpec (tests) where++import Data.Map.Strict qualified as Map+import Data.Text qualified as T+import Seihou.Core.Recipe (validateRecipe)+import Seihou.Core.Types+import Test.Hspec+import Test.Tasty+import Test.Tasty.Hspec (testSpec)++tests :: IO TestTree+tests = testSpec "Seihou.Core.Recipe" spec++hasError :: T.Text -> [T.Text] -> Bool+hasError needle = any (T.isInfixOf needle)++spec :: Spec+spec = do+  describe "validateRecipe" $ do+    it "passes a valid recipe" $ do+      let recipe =+            Recipe+              { name = "valid-recipe",+                version = Just "1.0.0",+                description = Just "A valid recipe",+                modules = [simpleDep "mod-a", simpleDep "mod-b"],+                vars = [],+                prompts = []+              }+      validateRecipe recipe `shouldBe` Right recipe++    it "rejects an empty modules list" $ do+      let recipe =+            Recipe+              { name = "empty-recipe",+                version = Nothing,+                description = Nothing,+                modules = [],+                vars = [],+                prompts = []+              }+      case validateRecipe recipe of+        Left errs -> hasError "at least one module" errs `shouldBe` True+        Right _ -> expectationFailure "Expected validation failure"++    it "rejects an invalid recipe name" $ do+      let recipe =+            Recipe+              { name = "BadName",+                version = Nothing,+                description = Nothing,+                modules = [simpleDep "mod-a"],+                vars = [],+                prompts = []+              }+      case validateRecipe recipe of+        Left errs -> hasError "recipe name must match" errs `shouldBe` True+        Right _ -> expectationFailure "Expected validation failure"++    it "rejects duplicate module names" $ do+      let recipe =+            Recipe+              { name = "dup-recipe",+                version = Nothing,+                description = Nothing,+                modules = [simpleDep "mod-a", simpleDep "mod-b", simpleDep "mod-a"],+                vars = [],+                prompts = []+              }+      case validateRecipe recipe of+        Left errs -> hasError "duplicate module" errs `shouldBe` True+        Right _ -> expectationFailure "Expected validation failure"++    it "rejects invalid variable binding name" $ do+      let recipe =+            Recipe+              { name = "bad-var-recipe",+                version = Nothing,+                description = Nothing,+                modules =+                  [ Dependency (ModuleName "mod-a") (Map.singleton (VarName "INVALID") "val")+                  ],+                vars = [],+                prompts = []+              }+      case validateRecipe recipe of+        Left errs -> hasError "invalid var binding name" errs `shouldBe` True+        Right _ -> expectationFailure "Expected validation failure"++    it "accepts valid variable binding names with dots" $ do+      let recipe =+            Recipe+              { name = "dotted-vars",+                version = Nothing,+                description = Nothing,+                modules =+                  [ Dependency (ModuleName "mod-a") (Map.singleton (VarName "nix.system") "aarch64-darwin")+                  ],+                vars = [],+                prompts = []+              }+      validateRecipe recipe `shouldBe` Right recipe++    it "collects multiple errors at once" $ do+      let recipe =+            Recipe+              { name = "BadName",+                version = Nothing,+                description = Nothing,+                modules = [],+                vars = [],+                prompts = []+              }+      case validateRecipe recipe of+        Left errs -> length errs `shouldSatisfy` (>= 2)+        Right _ -> expectationFailure "Expected validation failure"
+ test/Seihou/Core/RegistryEmitSpec.hs view
@@ -0,0 +1,191 @@+module Seihou.Core.RegistryEmitSpec (tests) where++import Data.Text qualified as T+import Data.Text.IO qualified as TIO+import Seihou.Core.Registry (Registry (..), RegistryEntry (..), renderRegistryDhall)+import Seihou.Core.Types (ModuleName (..))+import Seihou.Dhall.Eval (evalRegistryFromFile)+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.Core.RegistryEmit" spec++spec :: Spec+spec = describe "renderRegistryDhall" $ do+  it "round-trips a registry with two modules and one recipe" $ do+    let reg =+          Registry+            { repoName = "Sample",+              repoDescription = Just "A sample registry",+              modules =+                [ RegistryEntry+                    { name = ModuleName "alpha",+                      version = Just "1.0.0",+                      path = "modules/alpha",+                      description = Just "Alpha module",+                      tags = ["starter", "haskell"]+                    },+                  RegistryEntry+                    { name = ModuleName "beta",+                      version = Nothing,+                      path = "modules/beta",+                      description = Nothing,+                      tags = []+                    }+                ],+              recipes =+                [ RegistryEntry+                    { name = ModuleName "library-recipe",+                      version = Just "0.1.0",+                      path = "recipes/library-recipe",+                      description = Just "Library recipe",+                      tags = ["lib"]+                    }+                ],+              blueprints = [],+              prompts = []+            }+    roundTrip reg++  it "round-trips a registry with no recipes" $ do+    let reg =+          Registry+            { repoName = "Modules Only",+              repoDescription = Nothing,+              modules =+                [ RegistryEntry+                    { name = ModuleName "solo",+                      version = Just "2.1.3",+                      path = "solo",+                      description = Nothing,+                      tags = []+                    }+                ],+              recipes = [],+              blueprints = [],+              prompts = []+            }+    roundTrip reg++  it "round-trips an entry with version = Nothing" $ do+    let reg =+          Registry+            { repoName = "Unversioned",+              repoDescription = Nothing,+              modules =+                [ RegistryEntry+                    { name = ModuleName "nover",+                      version = Nothing,+                      path = "nover",+                      description = Nothing,+                      tags = []+                    }+                ],+              recipes = [],+              blueprints = [],+              prompts = []+            }+    roundTrip reg++  it "escapes quotes and backslashes in description" $ do+    let reg =+          Registry+            { repoName = "Escape \"test\"",+              repoDescription = Just "has \"quotes\" and \\ backslashes",+              modules =+                [ RegistryEntry+                    { name = ModuleName "escaped",+                      version = Just "0.1.0",+                      path = "escaped",+                      description = Just "weird: \"quoted\" \\ and $var",+                      tags = ["has \"quote\""]+                    }+                ],+              recipes = [],+              blueprints = [],+              prompts = []+            }+    roundTrip reg++  it "round-trips an empty registry" $ do+    let reg =+          Registry+            { repoName = "Empty",+              repoDescription = Nothing,+              modules = [],+              recipes = [],+              blueprints = [],+              prompts = []+            }+    roundTrip reg++  it "round-trips a registry with all four entry kinds" $ do+    let reg =+          Registry+            { repoName = "All Four",+              repoDescription = Just "Modules, recipes, blueprints, and prompts",+              modules =+                [ RegistryEntry+                    { name = ModuleName "mod-one",+                      version = Just "1.0.0",+                      path = "modules/mod-one",+                      description = Just "Module entry",+                      tags = ["m"]+                    }+                ],+              recipes =+                [ RegistryEntry+                    { name = ModuleName "rec-one",+                      version = Just "0.2.0",+                      path = "recipes/rec-one",+                      description = Just "Recipe entry",+                      tags = ["r"]+                    }+                ],+              blueprints =+                [ RegistryEntry+                    { name = ModuleName "bp-one",+                      version = Just "0.3.0",+                      path = "blueprints/bp-one",+                      description = Just "Blueprint entry",+                      tags = ["agent", "service"]+                    },+                  RegistryEntry+                    { name = ModuleName "bp-two",+                      version = Nothing,+                      path = "blueprints/bp-two",+                      description = Nothing,+                      tags = []+                    }+                ],+              prompts =+                [ RegistryEntry+                    { name = ModuleName "prompt-one",+                      version = Just "0.4.0",+                      path = "prompts/prompt-one",+                      description = Just "Prompt entry",+                      tags = ["agent"]+                    }+                ]+            }+    roundTrip reg++roundTrip :: Registry -> Expectation+roundTrip reg =+  withSystemTempDirectory "seihou-registry-emit" $ \tmpDir -> do+    let path = tmpDir </> "seihou-registry.dhall"+    TIO.writeFile path (renderRegistryDhall reg)+    result <- evalRegistryFromFile path+    case result of+      Left err ->+        expectationFailure+          ( "expected round-trip success, got Left: "+              <> show err+              <> "\nrendered:\n"+              <> T.unpack (renderRegistryDhall reg)+          )+      Right decoded -> decoded `shouldBe` reg
+ test/Seihou/Core/RegistrySpec.hs view
@@ -0,0 +1,874 @@+module Seihou.Core.RegistrySpec (tests) where++import Data.List (isInfixOf)+import Data.Text (Text)+import Seihou.Core.Registry+  ( EntryKind (..),+    Registry (..),+    RegistryEntry (..),+    RegistryValidationIssue (..),+    RegistryValidationReport (..),+    RepoContents (..),+    SyncDiff (..),+    SyncReport (..),+    SyncStatus (..),+    computeRegistrySync,+    discoverRepoContents,+    validateRegistry,+    validateRegistryFull,+  )+import Seihou.Core.Types+import Seihou.Dhall.Eval (evalRegistryFromFile)+import System.Directory (createDirectoryIfMissing)+import System.FilePath ((</>))+import System.IO.Temp (withSystemTempDirectory)+import Test.Hspec+import Test.Tasty+import Test.Tasty.Hspec (testSpec)++tests :: IO TestTree+tests = testSpec "Seihou.Core.Registry" spec++spec :: Spec+spec = do+  describe "evalRegistryFromFile" $ do+    it "decodes a valid registry with two modules" $ do+      withSystemTempDirectory "seihou-registry-test" $ \tmpDir -> do+        let dhall =+              "{ repoName = \"Haskell Templates\"\n\+              \, repoDescription = Some \"A collection of Haskell project templates\"\n\+              \, modules =\n\+              \  [ { name = \"haskell-base\"\n\+              \    , version = None Text\n\+              \    , path = \"modules/haskell-base\"\n\+              \    , description = Some \"Minimal Haskell project with cabal\"\n\+              \    , tags = [ \"haskell\", \"starter\" ]\n\+              \    }\n\+              \  , { name = \"nix-flake\"\n\+              \    , version = None Text\n\+              \    , path = \"modules/nix-flake\"\n\+              \    , description = Some \"Nix flake overlay\"\n\+              \    , tags = [ \"nix\" ]\n\+              \    }\n\+              \  ]\n\+              \}"+        writeFile (tmpDir </> "seihou-registry.dhall") dhall+        result <- evalRegistryFromFile (tmpDir </> "seihou-registry.dhall")+        case result of+          Left err -> expectationFailure ("Expected Right, got Left: " <> show err)+          Right reg -> do+            reg.repoName `shouldBe` "Haskell Templates"+            reg.repoDescription `shouldBe` Just "A collection of Haskell project templates"+            length reg.modules `shouldBe` 2+            let (e1 : e2 : _) = reg.modules+            e1.name `shouldBe` ModuleName "haskell-base"+            e1.path `shouldBe` "modules/haskell-base"+            e1.description `shouldBe` Just "Minimal Haskell project with cabal"+            e1.tags `shouldBe` ["haskell", "starter"]+            e2.name `shouldBe` ModuleName "nix-flake"+            e2.tags `shouldBe` ["nix"]++    it "decodes a registry with an empty module list" $ do+      withSystemTempDirectory "seihou-registry-test" $ \tmpDir -> do+        let dhall =+              "{ repoName = \"Empty Collection\"\n\+              \, repoDescription = None Text\n\+              \, modules = [] : List { name : Text, version : Optional Text, path : Text, description : Optional Text, tags : List Text }\n\+              \}"+        writeFile (tmpDir </> "seihou-registry.dhall") dhall+        result <- evalRegistryFromFile (tmpDir </> "seihou-registry.dhall")+        case result of+          Left err -> expectationFailure ("Expected Right, got Left: " <> show err)+          Right reg -> do+            reg.repoName `shouldBe` "Empty Collection"+            reg.repoDescription `shouldBe` Nothing+            reg.modules `shouldBe` []++    it "decodes a registry with no description" $ do+      withSystemTempDirectory "seihou-registry-test" $ \tmpDir -> do+        let dhall =+              "{ repoName = \"Minimal\"\n\+              \, repoDescription = None Text\n\+              \, modules =\n\+              \  [ { name = \"one\"\n\+              \    , version = None Text\n\+              \    , path = \"one\"\n\+              \    , description = None Text\n\+              \    , tags = [] : List Text\n\+              \    }\n\+              \  ]\n\+              \}"+        writeFile (tmpDir </> "seihou-registry.dhall") dhall+        result <- evalRegistryFromFile (tmpDir </> "seihou-registry.dhall")+        case result of+          Left err -> expectationFailure ("Expected Right, got Left: " <> show err)+          Right reg -> do+            reg.repoDescription `shouldBe` Nothing+            let (e1 : _) = reg.modules+            e1.description `shouldBe` Nothing+            e1.tags `shouldBe` []++    it "returns RegistryEvalError for malformed registry (missing required field)" $ do+      withSystemTempDirectory "seihou-registry-test" $ \tmpDir -> do+        let dhall =+              "{ repoName = \"Bad\"\n\+              \, modules = [] : List { name : Text, version : Optional Text, path : Text, description : Optional Text, tags : List Text }\n\+              \}"+        writeFile (tmpDir </> "seihou-registry.dhall") dhall+        result <- evalRegistryFromFile (tmpDir </> "seihou-registry.dhall")+        case result of+          Left (RegistryEvalError _ _) -> pure ()+          Left other -> expectationFailure ("Expected RegistryEvalError, got: " <> show other)+          Right _ -> expectationFailure "Expected Left for malformed registry"++    it "returns RegistryEvalError for nonexistent file" $ do+      result <- evalRegistryFromFile "/nonexistent/path/seihou-registry.dhall"+      case result of+        Left (RegistryEvalError _ _) -> pure ()+        Left other -> expectationFailure ("Expected RegistryEvalError, got: " <> show other)+        Right _ -> expectationFailure "Expected Left for nonexistent file"++  describe "discoverRepoContents" $ do+    it "returns MultiModule when seihou-registry.dhall exists" $ do+      withSystemTempDirectory "seihou-discover-test" $ \tmpDir -> do+        writeRegistryFile tmpDir+        result <- discoverRepoContents evalRegistryFromFile tmpDir+        case result of+          MultiModule reg -> reg.repoName `shouldBe` "Test Registry"+          other -> expectationFailure ("Expected MultiModule, got: " <> show other)++    it "returns SingleModule when only module.dhall exists" $ do+      withSystemTempDirectory "seihou-discover-test" $ \tmpDir -> do+        writeMinimalModuleDhall (tmpDir </> "module.dhall")+        result <- discoverRepoContents evalRegistryFromFile tmpDir+        case result of+          SingleModule p -> p `shouldBe` tmpDir+          other -> expectationFailure ("Expected SingleModule, got: " <> show other)++    it "returns MultiModule when both registry and module.dhall exist" $ do+      withSystemTempDirectory "seihou-discover-test" $ \tmpDir -> do+        writeRegistryFile tmpDir+        writeMinimalModuleDhall (tmpDir </> "module.dhall")+        result <- discoverRepoContents evalRegistryFromFile tmpDir+        case result of+          MultiModule reg -> reg.repoName `shouldBe` "Test Registry"+          other -> expectationFailure ("Expected MultiModule (registry takes precedence), got: " <> show other)++    it "returns EmptyRepo when neither file exists" $ do+      withSystemTempDirectory "seihou-discover-test" $ \tmpDir -> do+        result <- discoverRepoContents evalRegistryFromFile tmpDir+        case result of+          EmptyRepo -> pure ()+          other -> expectationFailure ("Expected EmptyRepo, got: " <> show other)++    it "falls back to SingleModule when registry is malformed and module.dhall exists" $ do+      withSystemTempDirectory "seihou-discover-test" $ \tmpDir -> do+        writeFile (tmpDir </> "seihou-registry.dhall") "{ broken = True }"+        writeMinimalModuleDhall (tmpDir </> "module.dhall")+        result <- discoverRepoContents evalRegistryFromFile tmpDir+        case result of+          SingleModule _ -> pure ()+          other -> expectationFailure ("Expected SingleModule fallback, got: " <> show other)++  describe "validateRegistry" $ do+    it "returns no errors for a valid registry" $ do+      withSystemTempDirectory "seihou-validate-reg" $ \tmpDir -> do+        createDirectoryIfMissing True (tmpDir </> "mod-a")+        writeMinimalModuleDhall (tmpDir </> "mod-a" </> "module.dhall")+        let reg =+              Registry+                { repoName = "Test",+                  repoDescription = Nothing,+                  modules = [RegistryEntry (ModuleName "mod-a") Nothing "mod-a" Nothing []],+                  recipes = [],+                  blueprints = [],+                  prompts = []+                }+        errs <- validateRegistry tmpDir reg+        errs `shouldBe` []++    it "reports invalid module name" $ do+      withSystemTempDirectory "seihou-validate-reg" $ \tmpDir -> do+        createDirectoryIfMissing True (tmpDir </> "Bad_Name")+        writeMinimalModuleDhall (tmpDir </> "Bad_Name" </> "module.dhall")+        let reg =+              Registry+                { repoName = "Test",+                  repoDescription = Nothing,+                  modules = [RegistryEntry (ModuleName "Bad_Name") Nothing "Bad_Name" Nothing []],+                  recipes = [],+                  blueprints = [],+                  prompts = []+                }+        errs <- validateRegistry tmpDir reg+        length errs `shouldSatisfy` (> 0)+        any ("must match" `isInfixOf`) (map show errs) `shouldBe` True++    it "reports missing module.dhall at entry path" $ do+      withSystemTempDirectory "seihou-validate-reg" $ \tmpDir -> do+        let reg =+              Registry+                { repoName = "Test",+                  repoDescription = Nothing,+                  modules = [RegistryEntry (ModuleName "missing") Nothing "nonexistent" Nothing []],+                  recipes = [],+                  blueprints = [],+                  prompts = []+                }+        errs <- validateRegistry tmpDir reg+        length errs `shouldSatisfy` (> 0)+        any ("missing module.dhall" `isInfixOf`) (map show errs) `shouldBe` True++    it "reports unsafe path with .." $ do+      withSystemTempDirectory "seihou-validate-reg" $ \tmpDir -> do+        let reg =+              Registry+                { repoName = "Test",+                  repoDescription = Nothing,+                  modules = [RegistryEntry (ModuleName "bad-path") Nothing "../escape" Nothing []],+                  recipes = [],+                  blueprints = [],+                  prompts = []+                }+        errs <- validateRegistry tmpDir reg+        any ("must not contain" `isInfixOf`) (map show errs) `shouldBe` True++  describe "validateRegistryFull" $ do+    it "returns no issues for a fully clean registry" $ do+      withSystemTempDirectory "seihou-validate-full" $ \tmpDir -> do+        createDirectoryIfMissing True (tmpDir </> "mod-a")+        writeMinimalModuleDhall (tmpDir </> "mod-a" </> "module.dhall")+        let reg =+              Registry+                { repoName = "Test",+                  repoDescription = Nothing,+                  modules = [RegistryEntry (ModuleName "mod-a") (Just "1.0.0") "mod-a" Nothing []],+                  recipes = [],+                  blueprints = [],+                  prompts = []+                }+            lookups = [(ModuleEntry, ModuleName "mod-a", Just "1.0.0")]+        report <- validateRegistryFull tmpDir reg lookups+        report.reportIssues `shouldBe` []+        report.reportModuleCount `shouldBe` 1+        report.reportRecipeCount `shouldBe` 0+        report.reportBlueprintCount `shouldBe` 0+        report.reportPromptCount `shouldBe` 0++    it "flags a SyncMissing entry as a single VersionMismatch" $ do+      withSystemTempDirectory "seihou-validate-full" $ \tmpDir -> do+        createDirectoryIfMissing True (tmpDir </> "mod-a")+        writeMinimalModuleDhall (tmpDir </> "mod-a" </> "module.dhall")+        let reg =+              Registry+                { repoName = "Test",+                  repoDescription = Nothing,+                  modules = [RegistryEntry (ModuleName "mod-a") Nothing "mod-a" Nothing []],+                  recipes = [],+                  blueprints = [],+                  prompts = []+                }+            lookups = [(ModuleEntry, ModuleName "mod-a", Just "1.0.0")]+        report <- validateRegistryFull tmpDir reg lookups+        case report.reportIssues of+          [VersionMismatch d] -> d.diffStatus `shouldBe` SyncMissing+          other -> expectationFailure ("expected one VersionMismatch SyncMissing, got: " <> show other)++    it "flags a SyncStale entry as a single VersionMismatch carrying the new version" $ do+      withSystemTempDirectory "seihou-validate-full" $ \tmpDir -> do+        createDirectoryIfMissing True (tmpDir </> "mod-a")+        writeMinimalModuleDhall (tmpDir </> "mod-a" </> "module.dhall")+        let reg =+              Registry+                { repoName = "Test",+                  repoDescription = Nothing,+                  modules = [RegistryEntry (ModuleName "mod-a") (Just "1.0.0") "mod-a" Nothing []],+                  recipes = [],+                  blueprints = [],+                  prompts = []+                }+            lookups = [(ModuleEntry, ModuleName "mod-a", Just "2.0.0")]+        report <- validateRegistryFull tmpDir reg lookups+        case report.reportIssues of+          [VersionMismatch d] -> d.diffStatus `shouldBe` SyncStale "2.0.0"+          other -> expectationFailure ("expected one VersionMismatch SyncStale, got: " <> show other)++    it "flags an invalid module name as a StructuralError" $ do+      withSystemTempDirectory "seihou-validate-full" $ \tmpDir -> do+        createDirectoryIfMissing True (tmpDir </> "Bad_Name")+        writeMinimalModuleDhall (tmpDir </> "Bad_Name" </> "module.dhall")+        let reg =+              Registry+                { repoName = "Test",+                  repoDescription = Nothing,+                  modules = [RegistryEntry (ModuleName "Bad_Name") Nothing "Bad_Name" Nothing []],+                  recipes = [],+                  blueprints = [],+                  prompts = []+                }+            lookups = [(ModuleEntry, ModuleName "Bad_Name", Nothing)]+        report <- validateRegistryFull tmpDir reg lookups+        let structurals = [msg | StructuralError msg <- report.reportIssues]+        any ("must match" `isInfixOf`) (map show structurals) `shouldBe` True++    it "flags an unsafe path with .. as a StructuralError" $ do+      withSystemTempDirectory "seihou-validate-full" $ \tmpDir -> do+        let reg =+              Registry+                { repoName = "Test",+                  repoDescription = Nothing,+                  modules = [RegistryEntry (ModuleName "escape") Nothing "../escape" Nothing []],+                  recipes = [],+                  blueprints = [],+                  prompts = []+                }+        report <- validateRegistryFull tmpDir reg []+        let structurals = [msg | StructuralError msg <- report.reportIssues]+        any ("must not contain" `isInfixOf`) (map show structurals) `shouldBe` True++    it "lists structural issues before version issues when both are present" $ do+      withSystemTempDirectory "seihou-validate-full" $ \tmpDir -> do+        createDirectoryIfMissing True (tmpDir </> "good")+        writeMinimalModuleDhall (tmpDir </> "good" </> "module.dhall")+        createDirectoryIfMissing True (tmpDir </> "stale")+        writeMinimalModuleDhall (tmpDir </> "stale" </> "module.dhall")+        let reg =+              Registry+                { repoName = "Test",+                  repoDescription = Nothing,+                  modules =+                    [ RegistryEntry (ModuleName "good") (Just "1.0.0") "good" Nothing [],+                      RegistryEntry (ModuleName "missing-mod") Nothing "no-such-dir" Nothing [],+                      RegistryEntry (ModuleName "stale") (Just "1.0.0") "stale" Nothing []+                    ],+                  recipes = [],+                  blueprints = [],+                  prompts = []+                }+            lookups =+              [ (ModuleEntry, ModuleName "good", Just "1.0.0"),+                (ModuleEntry, ModuleName "stale", Just "2.0.0")+              ]+        report <- validateRegistryFull tmpDir reg lookups+        length report.reportIssues `shouldBe` 2+        case report.reportIssues of+          [StructuralError msg, VersionMismatch d] -> do+            ("missing module.dhall" `isInfixOf` show msg) `shouldBe` True+            d.diffStatus `shouldBe` SyncStale "2.0.0"+          other ->+            expectationFailure+              ("expected [StructuralError, VersionMismatch], got: " <> show other)++  describe "blueprints in registries" $ do+    it "decodes a registry with all four entry kinds" $ do+      withSystemTempDirectory "seihou-registry-bp" $ \tmpDir -> do+        let dhall =+              "{ repoName = \"Four Kinds\"\n\+              \, repoDescription = None Text\n\+              \, modules =\n\+              \  [ { name = \"mod-one\"\n\+              \    , version = None Text\n\+              \    , path = \"modules/mod-one\"\n\+              \    , description = None Text\n\+              \    , tags = [] : List Text\n\+              \    }\n\+              \  ]\n\+              \, recipes =\n\+              \  [ { name = \"rec-one\"\n\+              \    , version = None Text\n\+              \    , path = \"recipes/rec-one\"\n\+              \    , description = None Text\n\+              \    , tags = [] : List Text\n\+              \    }\n\+              \  ]\n\+              \, blueprints =\n\+              \  [ { name = \"bp-one\"\n\+              \    , version = Some \"0.1.0\"\n\+              \    , path = \"blueprints/bp-one\"\n\+              \    , description = Some \"A blueprint\"\n\+              \    , tags = [ \"agent\" ]\n\+              \    }\n\+              \  ]\n\+              \, prompts =\n\+              \  [ { name = \"prompt-one\"\n\+              \    , version = Some \"0.2.0\"\n\+              \    , path = \"prompts/prompt-one\"\n\+              \    , description = Some \"A prompt\"\n\+              \    , tags = [ \"review\" ]\n\+              \    }\n\+              \  ]\n\+              \}"+        writeFile (tmpDir </> "seihou-registry.dhall") dhall+        result <- evalRegistryFromFile (tmpDir </> "seihou-registry.dhall")+        case result of+          Left err -> expectationFailure ("Expected Right, got Left: " <> show err)+          Right reg -> do+            length reg.modules `shouldBe` 1+            length reg.recipes `shouldBe` 1+            length reg.blueprints `shouldBe` 1+            length reg.prompts `shouldBe` 1+            let (bp : _) = reg.blueprints+            bp.name `shouldBe` ModuleName "bp-one"+            bp.version `shouldBe` Just "0.1.0"+            bp.tags `shouldBe` ["agent"]+            let (prompt : _) = reg.prompts+            prompt.name `shouldBe` ModuleName "prompt-one"+            prompt.version `shouldBe` Just "0.2.0"+            prompt.tags `shouldBe` ["review"]++    it "decodes a pre-EP-33 registry (no blueprints or prompts fields) with empty lists" $ do+      withSystemTempDirectory "seihou-registry-bp-compat" $ \tmpDir -> do+        let dhall =+              "{ repoName = \"Old Registry\"\n\+              \, repoDescription = None Text\n\+              \, modules =\n\+              \  [ { name = \"mod-a\"\n\+              \    , version = None Text\n\+              \    , path = \"mod-a\"\n\+              \    , description = None Text\n\+              \    , tags = [] : List Text\n\+              \    }\n\+              \  ]\n\+              \}"+        writeFile (tmpDir </> "seihou-registry.dhall") dhall+        result <- evalRegistryFromFile (tmpDir </> "seihou-registry.dhall")+        case result of+          Left err -> expectationFailure ("Expected Right, got Left: " <> show err)+          Right reg -> do+            reg.recipes `shouldBe` []+            reg.blueprints `shouldBe` []+            reg.prompts `shouldBe` []++    it "rejects an invalid blueprint name" $ do+      withSystemTempDirectory "seihou-validate-bp" $ \tmpDir -> do+        createDirectoryIfMissing True (tmpDir </> "Bad_Bp")+        writeMinimalBlueprintDhall (tmpDir </> "Bad_Bp" </> "blueprint.dhall")+        let reg =+              Registry+                { repoName = "Test",+                  repoDescription = Nothing,+                  modules = [],+                  recipes = [],+                  blueprints = [RegistryEntry (ModuleName "Bad_Bp") Nothing "Bad_Bp" Nothing []],+                  prompts = []+                }+        errs <- validateRegistry tmpDir reg+        any ("blueprint name must match" `isInfixOf`) (map show errs) `shouldBe` True++    it "reports a missing blueprint.dhall at the entry path" $ do+      withSystemTempDirectory "seihou-validate-bp-missing" $ \tmpDir -> do+        let reg =+              Registry+                { repoName = "Test",+                  repoDescription = Nothing,+                  modules = [],+                  recipes = [],+                  blueprints = [RegistryEntry (ModuleName "ghost") Nothing "ghost" Nothing []],+                  prompts = []+                }+        errs <- validateRegistry tmpDir reg+        any ("missing blueprint.dhall" `isInfixOf`) (map show errs) `shouldBe` True++    it "rejects an unsafe blueprint path with .." $ do+      withSystemTempDirectory "seihou-validate-bp-path" $ \tmpDir -> do+        let reg =+              Registry+                { repoName = "Test",+                  repoDescription = Nothing,+                  modules = [],+                  recipes = [],+                  blueprints = [RegistryEntry (ModuleName "escape") Nothing "../escape" Nothing []],+                  prompts = []+                }+        errs <- validateRegistry tmpDir reg+        any ("blueprint path must not contain" `isInfixOf`) (map show errs) `shouldBe` True++    it "detects module-blueprint and recipe-blueprint cross-kind name collisions" $ do+      withSystemTempDirectory "seihou-collision-bp" $ \tmpDir -> do+        createDirectoryIfMissing True (tmpDir </> "shared-mod")+        writeMinimalModuleDhall (tmpDir </> "shared-mod" </> "module.dhall")+        createDirectoryIfMissing True (tmpDir </> "shared-rec")+        writeMinimalRecipeDhall (tmpDir </> "shared-rec" </> "recipe.dhall")+        createDirectoryIfMissing True (tmpDir </> "shared-bp1")+        writeMinimalBlueprintDhall (tmpDir </> "shared-bp1" </> "blueprint.dhall")+        createDirectoryIfMissing True (tmpDir </> "shared-bp2")+        writeMinimalBlueprintDhall (tmpDir </> "shared-bp2" </> "blueprint.dhall")+        let reg =+              Registry+                { repoName = "Test",+                  repoDescription = Nothing,+                  modules = [RegistryEntry (ModuleName "duped") Nothing "shared-mod" Nothing []],+                  recipes = [RegistryEntry (ModuleName "other") Nothing "shared-rec" Nothing []],+                  blueprints =+                    [ RegistryEntry (ModuleName "duped") Nothing "shared-bp1" Nothing [],+                      RegistryEntry (ModuleName "other") Nothing "shared-bp2" Nothing []+                    ],+                  prompts = []+                }+        errs <- validateRegistry tmpDir reg+        any ("appears as both a module and a blueprint" `isInfixOf`) (map show errs)+          `shouldBe` True+        any ("appears as both a recipe and a blueprint" `isInfixOf`) (map show errs)+          `shouldBe` True++    it "detects a three-way name collision (module, recipe, and blueprint)" $ do+      withSystemTempDirectory "seihou-collision-three" $ \tmpDir -> do+        createDirectoryIfMissing True (tmpDir </> "trip-m")+        writeMinimalModuleDhall (tmpDir </> "trip-m" </> "module.dhall")+        createDirectoryIfMissing True (tmpDir </> "trip-r")+        writeMinimalRecipeDhall (tmpDir </> "trip-r" </> "recipe.dhall")+        createDirectoryIfMissing True (tmpDir </> "trip-b")+        writeMinimalBlueprintDhall (tmpDir </> "trip-b" </> "blueprint.dhall")+        let reg =+              Registry+                { repoName = "Test",+                  repoDescription = Nothing,+                  modules = [RegistryEntry (ModuleName "tripled") Nothing "trip-m" Nothing []],+                  recipes = [RegistryEntry (ModuleName "tripled") Nothing "trip-r" Nothing []],+                  blueprints = [RegistryEntry (ModuleName "tripled") Nothing "trip-b" Nothing []],+                  prompts = []+                }+        errs <- validateRegistry tmpDir reg+        let messages = map show errs+        any ("appears as both a module and a recipe" `isInfixOf`) messages `shouldBe` True+        any ("appears as both a module and a blueprint" `isInfixOf`) messages `shouldBe` True+        any ("appears as both a recipe and a blueprint" `isInfixOf`) messages `shouldBe` True++    it "computeRegistrySync classifies blueprint entries with diffKind = BlueprintEntry" $ do+      let reg =+            Registry+              { repoName = "Test",+                repoDescription = Nothing,+                modules = [],+                recipes = [],+                blueprints =+                  [ RegistryEntry (ModuleName "bp-stale") (Just "0.1.0") "blueprints/bp-stale" Nothing []+                  ],+                prompts = []+              }+          lookups = [(BlueprintEntry, ModuleName "bp-stale", Just "0.2.0")]+          SyncReport diffs updated = computeRegistrySync reg lookups+          kinds = [diff_ | SyncDiff {diffKind = diff_} <- diffs]+          statuses = [s | SyncDiff {diffStatus = s} <- diffs]+      kinds `shouldBe` [BlueprintEntry]+      statuses `shouldBe` [SyncStale "0.2.0"]+      let updatedVersion = case updated.blueprints of+            (RegistryEntry _ v _ _ _ : _) -> v+            _ -> Nothing+      updatedVersion `shouldBe` Just ("0.2.0" :: Text)++    it "validateRegistryFull populates reportBlueprintCount" $ do+      withSystemTempDirectory "seihou-validate-bp-count" $ \tmpDir -> do+        createDirectoryIfMissing True (tmpDir </> "bp-a")+        writeMinimalBlueprintDhall (tmpDir </> "bp-a" </> "blueprint.dhall")+        createDirectoryIfMissing True (tmpDir </> "bp-b")+        writeMinimalBlueprintDhall (tmpDir </> "bp-b" </> "blueprint.dhall")+        let reg =+              Registry+                { repoName = "Test",+                  repoDescription = Nothing,+                  modules = [],+                  recipes = [],+                  blueprints =+                    [ RegistryEntry (ModuleName "bp-a") (Just "1.0.0") "bp-a" Nothing [],+                      RegistryEntry (ModuleName "bp-b") (Just "1.0.0") "bp-b" Nothing []+                    ],+                  prompts = []+                }+            lookups =+              [ (BlueprintEntry, ModuleName "bp-a", Just "1.0.0"),+                (BlueprintEntry, ModuleName "bp-b", Just "1.0.0")+              ]+        report <- validateRegistryFull tmpDir reg lookups+        report.reportBlueprintCount `shouldBe` 2+        report.reportIssues `shouldBe` []++  describe "prompts in registries" $ do+    it "rejects an invalid prompt name" $ do+      withSystemTempDirectory "seihou-validate-prompt" $ \tmpDir -> do+        createDirectoryIfMissing True (tmpDir </> "Bad_Prompt")+        writeMinimalPromptDhall (tmpDir </> "Bad_Prompt" </> "prompt.dhall")+        let reg =+              Registry+                { repoName = "Test",+                  repoDescription = Nothing,+                  modules = [],+                  recipes = [],+                  blueprints = [],+                  prompts = [RegistryEntry (ModuleName "Bad_Prompt") Nothing "Bad_Prompt" Nothing []]+                }+        errs <- validateRegistry tmpDir reg+        any ("prompt name must match" `isInfixOf`) (map show errs) `shouldBe` True++    it "reports a missing prompt.dhall at the entry path" $ do+      withSystemTempDirectory "seihou-validate-prompt-missing" $ \tmpDir -> do+        let reg =+              Registry+                { repoName = "Test",+                  repoDescription = Nothing,+                  modules = [],+                  recipes = [],+                  blueprints = [],+                  prompts = [RegistryEntry (ModuleName "ghost") Nothing "ghost" Nothing []]+                }+        errs <- validateRegistry tmpDir reg+        any ("missing prompt.dhall" `isInfixOf`) (map show errs) `shouldBe` True++    it "rejects an unsafe prompt path with .." $ do+      withSystemTempDirectory "seihou-validate-prompt-path" $ \tmpDir -> do+        let reg =+              Registry+                { repoName = "Test",+                  repoDescription = Nothing,+                  modules = [],+                  recipes = [],+                  blueprints = [],+                  prompts = [RegistryEntry (ModuleName "escape") Nothing "../escape" Nothing []]+                }+        errs <- validateRegistry tmpDir reg+        any ("prompt path must not contain" `isInfixOf`) (map show errs) `shouldBe` True++    it "detects cross-kind name collisions involving prompts" $ do+      withSystemTempDirectory "seihou-collision-prompt" $ \tmpDir -> do+        createDirectoryIfMissing True (tmpDir </> "shared-mod")+        writeMinimalModuleDhall (tmpDir </> "shared-mod" </> "module.dhall")+        createDirectoryIfMissing True (tmpDir </> "shared-rec")+        writeMinimalRecipeDhall (tmpDir </> "shared-rec" </> "recipe.dhall")+        createDirectoryIfMissing True (tmpDir </> "shared-bp")+        writeMinimalBlueprintDhall (tmpDir </> "shared-bp" </> "blueprint.dhall")+        createDirectoryIfMissing True (tmpDir </> "shared-prompt1")+        writeMinimalPromptDhall (tmpDir </> "shared-prompt1" </> "prompt.dhall")+        createDirectoryIfMissing True (tmpDir </> "shared-prompt2")+        writeMinimalPromptDhall (tmpDir </> "shared-prompt2" </> "prompt.dhall")+        createDirectoryIfMissing True (tmpDir </> "shared-prompt3")+        writeMinimalPromptDhall (tmpDir </> "shared-prompt3" </> "prompt.dhall")+        let reg =+              Registry+                { repoName = "Test",+                  repoDescription = Nothing,+                  modules = [RegistryEntry (ModuleName "as-module") Nothing "shared-mod" Nothing []],+                  recipes = [RegistryEntry (ModuleName "as-recipe") Nothing "shared-rec" Nothing []],+                  blueprints = [RegistryEntry (ModuleName "as-blueprint") Nothing "shared-bp" Nothing []],+                  prompts =+                    [ RegistryEntry (ModuleName "as-module") Nothing "shared-prompt1" Nothing [],+                      RegistryEntry (ModuleName "as-recipe") Nothing "shared-prompt2" Nothing [],+                      RegistryEntry (ModuleName "as-blueprint") Nothing "shared-prompt3" Nothing []+                    ]+                }+        errs <- validateRegistry tmpDir reg+        let messages = map show errs+        any ("appears as both a module and a prompt" `isInfixOf`) messages `shouldBe` True+        any ("appears as both a recipe and a prompt" `isInfixOf`) messages `shouldBe` True+        any ("appears as both a blueprint and a prompt" `isInfixOf`) messages `shouldBe` True++    it "computeRegistrySync classifies prompt entries with diffKind = PromptEntry" $ do+      let reg =+            Registry+              { repoName = "Test",+                repoDescription = Nothing,+                modules = [],+                recipes = [],+                blueprints = [],+                prompts =+                  [ RegistryEntry (ModuleName "prompt-stale") (Just "0.1.0") "prompts/prompt-stale" Nothing []+                  ]+              }+          lookups = [(PromptEntry, ModuleName "prompt-stale", Just "0.2.0")]+          SyncReport diffs updated = computeRegistrySync reg lookups+          kinds = [diff_ | SyncDiff {diffKind = diff_} <- diffs]+          statuses = [s | SyncDiff {diffStatus = s} <- diffs]+      kinds `shouldBe` [PromptEntry]+      statuses `shouldBe` [SyncStale "0.2.0"]+      let updatedVersion = case updated.prompts of+            (RegistryEntry _ v _ _ _ : _) -> v+            _ -> Nothing+      updatedVersion `shouldBe` Just ("0.2.0" :: Text)++    it "validateRegistryFull populates reportPromptCount" $ do+      withSystemTempDirectory "seihou-validate-prompt-count" $ \tmpDir -> do+        createDirectoryIfMissing True (tmpDir </> "prompt-a")+        writeMinimalPromptDhall (tmpDir </> "prompt-a" </> "prompt.dhall")+        createDirectoryIfMissing True (tmpDir </> "prompt-b")+        writeMinimalPromptDhall (tmpDir </> "prompt-b" </> "prompt.dhall")+        let reg =+              Registry+                { repoName = "Test",+                  repoDescription = Nothing,+                  modules = [],+                  recipes = [],+                  blueprints = [],+                  prompts =+                    [ RegistryEntry (ModuleName "prompt-a") (Just "1.0.0") "prompt-a" Nothing [],+                      RegistryEntry (ModuleName "prompt-b") (Just "1.0.0") "prompt-b" Nothing []+                    ]+                }+            lookups =+              [ (PromptEntry, ModuleName "prompt-a", Just "1.0.0"),+                (PromptEntry, ModuleName "prompt-b", Just "1.0.0")+              ]+        report <- validateRegistryFull tmpDir reg lookups+        report.reportPromptCount `shouldBe` 2+        report.reportIssues `shouldBe` []++  describe "discoverRepoContents and blueprints" $ do+    it "returns SingleBlueprint when only blueprint.dhall is present" $ do+      withSystemTempDirectory "seihou-discover-bp" $ \tmpDir -> do+        writeMinimalBlueprintDhall (tmpDir </> "blueprint.dhall")+        result <- discoverRepoContents evalRegistryFromFile tmpDir+        case result of+          SingleBlueprint p -> p `shouldBe` tmpDir+          other -> expectationFailure ("Expected SingleBlueprint, got: " <> show other)++    it "prefers SingleModule over SingleBlueprint when both are present" $ do+      withSystemTempDirectory "seihou-discover-bp-mod" $ \tmpDir -> do+        writeMinimalModuleDhall (tmpDir </> "module.dhall")+        writeMinimalBlueprintDhall (tmpDir </> "blueprint.dhall")+        result <- discoverRepoContents evalRegistryFromFile tmpDir+        case result of+          SingleModule _ -> pure ()+          other -> expectationFailure ("Expected SingleModule (module beats blueprint), got: " <> show other)++    it "prefers SingleRecipe over SingleBlueprint when both are present" $ do+      withSystemTempDirectory "seihou-discover-bp-rec" $ \tmpDir -> do+        writeMinimalRecipeDhall (tmpDir </> "recipe.dhall")+        writeMinimalBlueprintDhall (tmpDir </> "blueprint.dhall")+        result <- discoverRepoContents evalRegistryFromFile tmpDir+        case result of+          SingleRecipe _ -> pure ()+          other -> expectationFailure ("Expected SingleRecipe (recipe beats blueprint), got: " <> show other)++    it "prefers MultiModule over SingleBlueprint when both registry and blueprint exist" $ do+      withSystemTempDirectory "seihou-discover-reg-bp" $ \tmpDir -> do+        writeRegistryFile tmpDir+        writeMinimalBlueprintDhall (tmpDir </> "blueprint.dhall")+        result <- discoverRepoContents evalRegistryFromFile tmpDir+        case result of+          MultiModule _ -> pure ()+          other -> expectationFailure ("Expected MultiModule (registry beats blueprint), got: " <> show other)++  describe "discoverRepoContents and prompts" $ do+    it "returns SinglePrompt when only prompt.dhall is present" $ do+      withSystemTempDirectory "seihou-discover-prompt" $ \tmpDir -> do+        writeMinimalPromptDhall (tmpDir </> "prompt.dhall")+        result <- discoverRepoContents evalRegistryFromFile tmpDir+        case result of+          SinglePrompt p -> p `shouldBe` tmpDir+          other -> expectationFailure ("Expected SinglePrompt, got: " <> show other)++    it "prefers SingleModule over SinglePrompt when both are present" $ do+      withSystemTempDirectory "seihou-discover-prompt-mod" $ \tmpDir -> do+        writeMinimalModuleDhall (tmpDir </> "module.dhall")+        writeMinimalPromptDhall (tmpDir </> "prompt.dhall")+        result <- discoverRepoContents evalRegistryFromFile tmpDir+        case result of+          SingleModule _ -> pure ()+          other -> expectationFailure ("Expected SingleModule (module beats prompt), got: " <> show other)++    it "prefers SingleRecipe over SinglePrompt when both are present" $ do+      withSystemTempDirectory "seihou-discover-prompt-rec" $ \tmpDir -> do+        writeMinimalRecipeDhall (tmpDir </> "recipe.dhall")+        writeMinimalPromptDhall (tmpDir </> "prompt.dhall")+        result <- discoverRepoContents evalRegistryFromFile tmpDir+        case result of+          SingleRecipe _ -> pure ()+          other -> expectationFailure ("Expected SingleRecipe (recipe beats prompt), got: " <> show other)++    it "prefers SingleBlueprint over SinglePrompt when both are present" $ do+      withSystemTempDirectory "seihou-discover-prompt-bp" $ \tmpDir -> do+        writeMinimalBlueprintDhall (tmpDir </> "blueprint.dhall")+        writeMinimalPromptDhall (tmpDir </> "prompt.dhall")+        result <- discoverRepoContents evalRegistryFromFile tmpDir+        case result of+          SingleBlueprint _ -> pure ()+          other -> expectationFailure ("Expected SingleBlueprint (blueprint beats prompt), got: " <> show other)++    it "prefers MultiModule over SinglePrompt when both registry and prompt exist" $ do+      withSystemTempDirectory "seihou-discover-reg-prompt" $ \tmpDir -> do+        writeRegistryFile tmpDir+        writeMinimalPromptDhall (tmpDir </> "prompt.dhall")+        result <- discoverRepoContents evalRegistryFromFile tmpDir+        case result of+          MultiModule _ -> pure ()+          other -> expectationFailure ("Expected MultiModule (registry beats prompt), got: " <> show other)++-- Helper: write a minimal valid seihou-registry.dhall+writeRegistryFile :: FilePath -> IO ()+writeRegistryFile dir = do+  let dhall =+        "{ repoName = \"Test Registry\"\n\+        \, repoDescription = Some \"A test registry\"\n\+        \, modules =\n\+        \  [ { name = \"mod-a\"\n\+        \    , version = None Text\n\+        \    , path = \"mod-a\"\n\+        \    , description = Some \"Module A\"\n\+        \    , tags = [ \"test\" ]\n\+        \    }\n\+        \  ]\n\+        \}"+  writeFile (dir </> "seihou-registry.dhall") dhall++-- Helper: write a minimal valid module.dhall+writeMinimalModuleDhall :: FilePath -> IO ()+writeMinimalModuleDhall path = do+  let dhall =+        "{ name = \"minimal\"\n\+        \, version = None Text\n\+        \, description = None Text\n\+        \, vars = [] : List { name : Text, type : Text, default : Optional Text, description : Optional Text, required : Bool, validation : Optional Text }\n\+        \, exports = [] : List { var : Text, alias : Optional Text }\n\+        \, prompts = [] : List { var : Text, text : Text, when : Optional Text, choices : Optional (List Text) }\n\+        \, steps = [] : List { strategy : Text, src : Text, dest : Text, when : Optional Text, patch : Optional Text }\n\+        \, commands = [] : List { run : Text, workDir : Optional Text, when : Optional Text }\n\+        \, dependencies = [] : List Text\n\+        \, removal = None { steps : List { action : Text, dest : Text, src : Optional Text }, commands : List { run : Text, workDir : Optional Text, when : Optional Text } }\n\+        \}"+  writeFile path dhall++-- Helper: write a minimal valid recipe.dhall+writeMinimalRecipeDhall :: FilePath -> IO ()+writeMinimalRecipeDhall path = do+  let dhall =+        "{ name = \"minimal\"\n\+        \, version = None Text\n\+        \, description = None Text\n\+        \, modules = [] : List Text\n\+        \, vars = [] : List { name : Text, type : Text, default : Optional Text, description : Optional Text, required : Bool, validation : Optional Text }\n\+        \, prompts = [] : List { var : Text, text : Text, when : Optional Text, choices : Optional (List Text) }\n\+        \}"+  writeFile path dhall++-- Helper: write a minimal valid blueprint.dhall+writeMinimalBlueprintDhall :: FilePath -> IO ()+writeMinimalBlueprintDhall path = do+  let dhall =+        "{ name = \"minimal-bp\"\n\+        \, version = Some \"0.1.0\"\n\+        \, description = None Text\n\+        \, prompt = \"hello\"\n\+        \, vars = [] : List { name : Text, type : Text, default : Optional Text, description : Optional Text, required : Bool, validation : Optional Text }\n\+        \, prompts = [] : List { var : Text, text : Text, when : Optional Text, choices : Optional (List Text) }\n\+        \, baseModules = [] : List { module : Text, vars : List { name : Text, value : Text } }\n\+        \, files = [] : List { src : Text, description : Optional Text }\n\+        \, allowedTools = None (List Text)\n\+        \, tags = [] : List Text\n\+        \}"+  writeFile path dhall++-- Helper: write a minimal valid prompt.dhall+writeMinimalPromptDhall :: FilePath -> IO ()+writeMinimalPromptDhall path = do+  let dhall =+        "{ name = \"minimal-prompt\"\n\+        \, version = Some \"0.1.0\"\n\+        \, description = None Text\n\+        \, prompt = \"hello\"\n\+        \, vars = [] : List { name : Text, type : Text, default : Optional Text, description : Optional Text, required : Bool, validation : Optional Text }\n\+        \, prompts = [] : List { var : Text, text : Text, when : Optional Text, choices : Optional (List Text) }\n\+        \, commandVars = [] : List { name : Text, run : Text, workDir : Optional Text, when : Optional Text, trim : Bool, maxBytes : Optional Natural }\n\+        \, files = [] : List { src : Text, description : Optional Text }\n\+        \, allowedTools = None (List Text)\n\+        \, tags = [] : List Text\n\+        \, launch = None { provider : Optional Text, mode : Optional Text, model : Optional Text }\n\+        \}"+  writeFile path dhall
+ test/Seihou/Core/RegistrySyncSpec.hs view
@@ -0,0 +1,166 @@+module Seihou.Core.RegistrySyncSpec (tests) where++import Data.Maybe (isJust, mapMaybe)+import Data.Text (Text)+import Data.Text qualified as T+import Seihou.Core.Registry+  ( EntryKind (..),+    Registry (..),+    RegistryEntry (..),+    SyncDiff (..),+    SyncReport (..),+    SyncStatus (..),+    computeRegistrySync,+    formatDriftWarning,+  )+import Seihou.Core.Types (ModuleName (..))+import Test.Hspec+import Test.Tasty+import Test.Tasty.Hspec (testSpec)++tests :: IO TestTree+tests = testSpec "Seihou.Core.RegistrySync" spec++spec :: Spec+spec = describe "computeRegistrySync" $ do+  it "classifies SyncMissing when registry version is Nothing and disk has a version" $ do+    let entry = mkEntry "alpha" Nothing+        reg = mkReg [entry] []+        report = computeRegistrySync reg [(ModuleEntry, ModuleName "alpha", Just "1.0.0")]+    map (.diffStatus) report.syncDiffs `shouldBe` [SyncMissing]+    map (.diffNew) report.syncDiffs `shouldBe` [Just "1.0.0"]+    (head report.syncUpdated.modules).version `shouldBe` Just "1.0.0"++  it "classifies SyncStale when registry and disk versions differ" $ do+    let entry = mkEntry "alpha" (Just "0.1.0")+        reg = mkReg [entry] []+        report = computeRegistrySync reg [(ModuleEntry, ModuleName "alpha", Just "1.0.0")]+    map (.diffStatus) report.syncDiffs `shouldBe` [SyncStale "1.0.0"]+    map (.diffOld) report.syncDiffs `shouldBe` [Just "0.1.0"]+    map (.diffNew) report.syncDiffs `shouldBe` [Just "1.0.0"]+    (head report.syncUpdated.modules).version `shouldBe` Just "1.0.0"++  it "classifies SyncInSync when registry and disk versions match" $ do+    let entry = mkEntry "alpha" (Just "1.0.0")+        reg = mkReg [entry] []+        report = computeRegistrySync reg [(ModuleEntry, ModuleName "alpha", Just "1.0.0")]+    map (.diffStatus) report.syncDiffs `shouldBe` [SyncInSync]+    (head report.syncUpdated.modules).version `shouldBe` Just "1.0.0"++  it "classifies SyncInSync when registry and disk are both Nothing" $ do+    let entry = mkEntry "alpha" Nothing+        reg = mkReg [entry] []+        report = computeRegistrySync reg [(ModuleEntry, ModuleName "alpha", Nothing)]+    map (.diffStatus) report.syncDiffs `shouldBe` [SyncInSync]+    (head report.syncUpdated.modules).version `shouldBe` Nothing++  it "classifies SyncOrphan when the entry has no lookup (module.dhall absent/unreadable)" $ do+    let entry = mkEntry "alpha" (Just "1.0.0")+        reg = mkReg [entry] []+        report = computeRegistrySync reg []+    map (.diffStatus) report.syncDiffs `shouldBe` [SyncOrphan]+    -- Orphan: version left as-is+    (head report.syncUpdated.modules).version `shouldBe` Just "1.0.0"++  it "preserves registry order in the diff output" $ do+    let reg =+          ( mkReg+              [ mkEntry "alpha" Nothing,+                mkEntry "beta" (Just "0.1.0"),+                mkEntry "gamma" (Just "2.0.0")+              ]+              [mkEntry "lib-one" Nothing]+          )+            { prompts = [mkEntry "review" Nothing]+            }+        lookups =+          [ (ModuleEntry, ModuleName "alpha", Just "1.0.0"),+            (ModuleEntry, ModuleName "beta", Just "0.2.0"),+            (ModuleEntry, ModuleName "gamma", Just "2.0.0"),+            (RecipeEntry, ModuleName "lib-one", Just "0.3.0"),+            (PromptEntry, ModuleName "review", Just "0.4.0")+          ]+        report = computeRegistrySync reg lookups+    map (.diffName) report.syncDiffs+      `shouldBe` [ ModuleName "alpha",+                   ModuleName "beta",+                   ModuleName "gamma",+                   ModuleName "lib-one",+                   ModuleName "review"+                 ]+    map (.diffKind) report.syncDiffs+      `shouldBe` [ModuleEntry, ModuleEntry, ModuleEntry, RecipeEntry, PromptEntry]+    map (.diffStatus) report.syncDiffs+      `shouldBe` [SyncMissing, SyncStale "0.2.0", SyncInSync, SyncMissing, SyncMissing]++  it "returns an empty report for an empty registry" $ do+    let reg = mkReg [] []+        report = computeRegistrySync reg []+    report.syncDiffs `shouldBe` []+    report.syncUpdated `shouldBe` reg++  it "distinguishes module and recipe entries with the same name in lookups" $ do+    -- Module and recipe namespaces share a validation check,+    -- but the sync lookup must distinguish them by kind.+    let reg =+          mkReg+            [mkEntry "alpha" Nothing]+            [mkEntry "beta" Nothing]+        lookups =+          [ (ModuleEntry, ModuleName "alpha", Just "1.0.0"),+            (RecipeEntry, ModuleName "beta", Just "2.0.0")+          ]+        report = computeRegistrySync reg lookups+    map (.diffNew) report.syncDiffs `shouldBe` [Just "1.0.0", Just "2.0.0"]++  describe "formatDriftWarning" $ do+    it "produces a warning for a stale entry" $ do+      let reg = mkReg [mkEntry "alpha" (Just "0.1.0")] []+          lookups = [(ModuleEntry, ModuleName "alpha", Just "1.0.0")]+          report = computeRegistrySync reg lookups+          warnings = mapMaybe formatDriftWarning report.syncDiffs+      length warnings `shouldBe` 1+      isJust (formatDriftWarning (head report.syncDiffs)) `shouldBe` True++    it "produces no warnings when all entries are in sync" $ do+      let reg = mkReg [mkEntry "alpha" (Just "1.0.0")] []+          lookups = [(ModuleEntry, ModuleName "alpha", Just "1.0.0")]+          report = computeRegistrySync reg lookups+          warnings = mapMaybe formatDriftWarning report.syncDiffs+      warnings `shouldBe` []++    it "produces no warnings for orphan entries (handled by validateRegistry)" $ do+      let reg = mkReg [mkEntry "alpha" (Just "1.0.0")] []+          report = computeRegistrySync reg []+          warnings = mapMaybe formatDriftWarning report.syncDiffs+      warnings `shouldBe` []++    it "mentions prompt.dhall in stale prompt warnings" $ do+      let reg = (mkReg [] []) {prompts = [mkEntry "review" (Just "0.1.0")]}+          lookups = [(PromptEntry, ModuleName "review", Just "0.2.0")]+          report = computeRegistrySync reg lookups+          warnings = mapMaybe formatDriftWarning report.syncDiffs+      warnings+        `shouldBe` [ "prompt 'review' registry version 0.1.0 differs from prompt.dhall version 0.2.0 — run `seihou registry sync-versions`"+                   ]++mkEntry :: Text -> Maybe Text -> RegistryEntry+mkEntry n v =+  RegistryEntry+    { name = ModuleName n,+      version = v,+      path = "modules/" <> T.unpack n,+      description = Nothing,+      tags = []+    }++mkReg :: [RegistryEntry] -> [RegistryEntry] -> Registry+mkReg mods recs =+  Registry+    { repoName = "Test",+      repoDescription = Nothing,+      modules = mods,+      recipes = recs,+      blueprints = [],+      prompts = []+    }
+ test/Seihou/Core/ScaffoldSpec.hs view
@@ -0,0 +1,240 @@+module Seihou.Core.ScaffoldSpec (tests) where++import Data.Text qualified as T+import Seihou.Core.AgentPrompt (validateAgentPrompt)+import Seihou.Core.Blueprint (validateBlueprint)+import Seihou.Core.Module (validateModule)+import Seihou.Core.Scaffold (blueprintDhall, exampleAgentPromptMarkdown, examplePromptMarkdown, moduleDhall, promptDhall, readmeTemplate)+import Seihou.Core.Types+import Seihou.Dhall.Eval (evalAgentPromptFromFile, evalBlueprintFromFile, evalModuleFromFile)+import System.Directory (createDirectoryIfMissing, doesDirectoryExist, makeAbsolute)+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.Core.Scaffold" spec++-- | Resolve the local schema path for tests, trying both package-relative and+-- project root-relative locations (like mori's fixturePath pattern).+-- Uses an absolute path since generated Dhall is written to a temp directory.+resolveSchemaPath :: IO T.Text+resolveSchemaPath = do+  let pkgRelative = "../schema/package.dhall"+      rootRelative = "schema/package.dhall"+  pkgExists <- doesDirectoryExist "../schema"+  path <-+    if pkgExists+      then makeAbsolute pkgRelative+      else makeAbsolute rootRelative+  pure (T.pack path)++spec :: Spec+spec = do+  describe "moduleDhall" $ do+    it "generates Dhall that includes schema import" $ do+      schemaPath <- resolveSchemaPath+      let content = moduleDhall "test-mod" schemaPath ""+      T.isInfixOf "let S =" content `shouldBe` True+      T.isInfixOf "S.Module::" content `shouldBe` True++    it "generates Dhall that loads via evalModuleFromFile" $ do+      schemaPath <- resolveSchemaPath+      withSystemTempDirectory "seihou-scaffold-test" $ \tmpDir -> do+        let modDir = tmpDir </> "test-mod"+            dhallFile = modDir </> "module.dhall"+            filesDir = modDir </> "files"+        createDirectoryIfMissing True filesDir+        writeFile dhallFile (T.unpack (moduleDhall "test-mod" schemaPath ""))+        writeFile (filesDir </> "README.md.tpl") (T.unpack readmeTemplate)+        result <- evalModuleFromFile dhallFile+        case result of+          Left err -> expectationFailure $ "Failed to load generated module: " ++ show err+          Right m -> m.name `shouldBe` "test-mod"++    it "generates a module that passes validateModule" $ do+      schemaPath <- resolveSchemaPath+      withSystemTempDirectory "seihou-scaffold-test" $ \tmpDir -> do+        let modDir = tmpDir </> "test-mod"+            dhallFile = modDir </> "module.dhall"+            filesDir = modDir </> "files"+        createDirectoryIfMissing True filesDir+        writeFile dhallFile (T.unpack (moduleDhall "test-mod" schemaPath ""))+        writeFile (filesDir </> "README.md.tpl") (T.unpack readmeTemplate)+        result <- evalModuleFromFile dhallFile+        case result of+          Left err -> expectationFailure $ "Failed to load: " ++ show err+          Right m -> do+            validated <- validateModule modDir m+            case validated of+              Left err -> expectationFailure $ "Validation failed: " ++ show err+              Right _ -> pure ()++    it "generates expected module structure" $ do+      schemaPath <- resolveSchemaPath+      withSystemTempDirectory "seihou-scaffold-test" $ \tmpDir -> do+        let modDir = tmpDir </> "test-mod"+            dhallFile = modDir </> "module.dhall"+            filesDir = modDir </> "files"+        createDirectoryIfMissing True filesDir+        writeFile dhallFile (T.unpack (moduleDhall "test-mod" schemaPath ""))+        writeFile (filesDir </> "README.md.tpl") (T.unpack readmeTemplate)+        result <- evalModuleFromFile dhallFile+        case result of+          Left err -> expectationFailure $ "Failed to load: " ++ show err+          Right m -> do+            length (m.vars) `shouldBe` 1+            map (.name) m.vars `shouldBe` ["project.name"]+            length (m.steps) `shouldBe` 1+            length (m.prompts) `shouldBe` 1+            length (m.commands) `shouldBe` 0+            length (m.exports) `shouldBe` 0+            length (m.dependencies) `shouldBe` 0++  describe "readmeTemplate" $ do+    it "contains the project.name placeholder" $ do+      T.isInfixOf "{{project.name}}" readmeTemplate `shouldBe` True++  describe "blueprintDhall" $ do+    it "generates Dhall that imports the schema and uses Blueprint::" $ do+      schemaPath <- resolveSchemaPath+      let content = blueprintDhall "test-bp" schemaPath ""+      T.isInfixOf "let S =" content `shouldBe` True+      T.isInfixOf "S.Blueprint::" content `shouldBe` True++    it "imports prompt.md as Text rather than inlining the body" $ do+      schemaPath <- resolveSchemaPath+      let content = blueprintDhall "test-bp" schemaPath ""+      T.isInfixOf "./prompt.md as Text" content `shouldBe` True++    it "decodes via evalBlueprintFromFile when prompt.md is present" $ do+      schemaPath <- resolveSchemaPath+      withSystemTempDirectory "seihou-blueprint-scaffold-test" $ \tmpDir -> do+        let bpDir = tmpDir </> "test-bp"+            dhallFile = bpDir </> "blueprint.dhall"+            filesDir = bpDir </> "files"+        createDirectoryIfMissing True filesDir+        writeFile dhallFile (T.unpack (blueprintDhall "test-bp" schemaPath ""))+        writeFile (bpDir </> "prompt.md") (T.unpack examplePromptMarkdown)+        result <- evalBlueprintFromFile dhallFile+        case result of+          Left err -> expectationFailure $ "Failed to load generated blueprint: " ++ show err+          Right b -> b.name `shouldBe` "test-bp"++    it "produces a blueprint that passes validateBlueprint" $ do+      schemaPath <- resolveSchemaPath+      withSystemTempDirectory "seihou-blueprint-scaffold-test" $ \tmpDir -> do+        let bpDir = tmpDir </> "test-bp"+            dhallFile = bpDir </> "blueprint.dhall"+            filesDir = bpDir </> "files"+        createDirectoryIfMissing True filesDir+        writeFile dhallFile (T.unpack (blueprintDhall "test-bp" schemaPath ""))+        writeFile (bpDir </> "prompt.md") (T.unpack examplePromptMarkdown)+        result <- evalBlueprintFromFile dhallFile+        case result of+          Left err -> expectationFailure $ "Failed to load: " ++ show err+          Right b -> do+            validated <- validateBlueprint bpDir b+            case validated of+              Left err -> expectationFailure $ "Validation failed: " ++ show err+              Right _ -> pure ()++    it "produces the expected blueprint structure (1 var, 1 prompt, 0 base modules, 0 files)" $ do+      schemaPath <- resolveSchemaPath+      withSystemTempDirectory "seihou-blueprint-scaffold-test" $ \tmpDir -> do+        let bpDir = tmpDir </> "test-bp"+            dhallFile = bpDir </> "blueprint.dhall"+            filesDir = bpDir </> "files"+        createDirectoryIfMissing True filesDir+        writeFile dhallFile (T.unpack (blueprintDhall "test-bp" schemaPath ""))+        writeFile (bpDir </> "prompt.md") (T.unpack examplePromptMarkdown)+        result <- evalBlueprintFromFile dhallFile+        case result of+          Left err -> expectationFailure $ "Failed to load: " ++ show err+          Right b -> do+            length (b.vars) `shouldBe` 1+            map (.name) b.vars `shouldBe` ["project.name"]+            length (b.prompts) `shouldBe` 1+            length (b.baseModules) `shouldBe` 0+            length (b.files) `shouldBe` 0+            length (b.tags) `shouldBe` 0++  describe "examplePromptMarkdown" $ do+    it "contains the {{project.name}} placeholder so authors see substitution" $ do+      T.isInfixOf "{{project.name}}" examplePromptMarkdown `shouldBe` True++    it "is non-empty after trimming (would otherwise fail prompt-non-empty validation)" $ do+      T.null (T.strip examplePromptMarkdown) `shouldBe` False++  describe "promptDhall" $ do+    it "generates self-contained Dhall with prompt-specific type aliases" $ do+      schemaPath <- resolveSchemaPath+      let content = promptDhall "review-changes" schemaPath ""+      T.isInfixOf "let Prompt =" content `shouldBe` True+      T.isInfixOf "let CommandVar =" content `shouldBe` True++    it "imports prompt.md as Text rather than inlining the body" $ do+      schemaPath <- resolveSchemaPath+      let content = promptDhall "review-changes" schemaPath ""+      T.isInfixOf "./prompt.md as Text" content `shouldBe` True++    it "decodes via evalAgentPromptFromFile when prompt.md is present" $ do+      schemaPath <- resolveSchemaPath+      withSystemTempDirectory "seihou-prompt-scaffold-test" $ \tmpDir -> do+        let promptDir = tmpDir </> "review-changes"+            dhallFile = promptDir </> "prompt.dhall"+            filesDir = promptDir </> "files"+        createDirectoryIfMissing True filesDir+        writeFile dhallFile (T.unpack (promptDhall "review-changes" schemaPath ""))+        writeFile (promptDir </> "prompt.md") (T.unpack exampleAgentPromptMarkdown)+        result <- evalAgentPromptFromFile dhallFile+        case result of+          Left err -> expectationFailure $ "Failed to load generated prompt: " ++ show err+          Right p -> p.name `shouldBe` "review-changes"++    it "produces a prompt that passes validateAgentPrompt" $ do+      schemaPath <- resolveSchemaPath+      withSystemTempDirectory "seihou-prompt-scaffold-test" $ \tmpDir -> do+        let promptDir = tmpDir </> "review-changes"+            dhallFile = promptDir </> "prompt.dhall"+            filesDir = promptDir </> "files"+        createDirectoryIfMissing True filesDir+        writeFile dhallFile (T.unpack (promptDhall "review-changes" schemaPath ""))+        writeFile (promptDir </> "prompt.md") (T.unpack exampleAgentPromptMarkdown)+        result <- evalAgentPromptFromFile dhallFile+        case result of+          Left err -> expectationFailure $ "Failed to load: " ++ show err+          Right p -> do+            validated <- validateAgentPrompt promptDir p+            case validated of+              Left err -> expectationFailure $ "Validation failed: " ++ show err+              Right _ -> pure ()++    it "produces the expected prompt structure" $ do+      schemaPath <- resolveSchemaPath+      withSystemTempDirectory "seihou-prompt-scaffold-test" $ \tmpDir -> do+        let promptDir = tmpDir </> "review-changes"+            dhallFile = promptDir </> "prompt.dhall"+            filesDir = promptDir </> "files"+        createDirectoryIfMissing True filesDir+        writeFile dhallFile (T.unpack (promptDhall "review-changes" schemaPath ""))+        writeFile (promptDir </> "prompt.md") (T.unpack exampleAgentPromptMarkdown)+        result <- evalAgentPromptFromFile dhallFile+        case result of+          Left err -> expectationFailure $ "Failed to load: " ++ show err+          Right p -> do+            length (p.vars) `shouldBe` 1+            map (.name) p.vars `shouldBe` ["project.name"]+            length (p.prompts) `shouldBe` 0+            length (p.commandVars) `shouldBe` 0+            length (p.files) `shouldBe` 0+            length (p.tags) `shouldBe` 0++  describe "exampleAgentPromptMarkdown" $ do+    it "contains the {{project.name}} placeholder so debug rendering shows substitution" $ do+      T.isInfixOf "{{project.name}}" exampleAgentPromptMarkdown `shouldBe` True++    it "is non-empty after trimming" $ do+      T.null (T.strip exampleAgentPromptMarkdown) `shouldBe` False
+ test/Seihou/Core/SchemaUpgradeSpec.hs view
@@ -0,0 +1,247 @@+module Seihou.Core.SchemaUpgradeSpec (tests) where++import Data.Text qualified as T+import Seihou.Core.SchemaUpgrade+import Test.Hspec+import Test.Tasty+import Test.Tasty.Hspec (testSpec)++-- Test schema URL and hash for upgrade tests+testUrl :: T.Text+testUrl = "https://raw.githubusercontent.com/shinzui/seihou-schema/abc123/package.dhall"++testHash :: T.Text+testHash = "sha256:0000000000000000000000000000000000000000000000000000000000000000"++tests :: IO TestTree+tests = testSpec "Seihou.Core.SchemaUpgrade" spec++-- | A module.dhall missing version, patch, and commands (pre-schema-evolution).+oldModuleText :: T.Text+oldModuleText =+  T.unlines+    [ "{ name = \"old-module\"",+      ", description = Some \"Pre-commands era module\"",+      ", vars = [] : List { name : Text, type : Text, default : Optional Text, description : Optional Text, required : Bool, validation : Optional Text }",+      ", exports = [] : List { var : Text, alias : Optional Text }",+      ", prompts = [] : List { var : Text, text : Text, when : Optional Text, choices : Optional (List Text) }",+      ", steps =",+      "  [ { strategy = \"copy\"",+      "    , src = \"foo\"",+      "    , dest = \"foo\"",+      "    , when = None Text",+      "    }",+      "  ]",+      ", dependencies = [] : List Text",+      "}"+    ]++-- | A module with bare string dependencies.+bareStringDepsText :: T.Text+bareStringDepsText =+  T.unlines+    [ "{ name = \"with-deps\"",+      ", version = None Text",+      ", description = Some \"Has bare string deps\"",+      ", vars = [] : List { name : Text, type : Text, default : Optional Text, description : Optional Text, required : Bool, validation : Optional Text }",+      ", exports = [] : List { var : Text, alias : Optional Text }",+      ", prompts = [] : List { var : Text, text : Text, when : Optional Text, choices : Optional (List Text) }",+      ", steps = [] : List { strategy : Text, src : Text, dest : Text, when : Optional Text, patch : Optional Text }",+      ", commands = [] : List { run : Text, workDir : Optional Text, when : Optional Text }",+      ", dependencies = [ \"haskell-base\", \"nix-flake\" ]",+      "}"+    ]++-- | A fully current module (with schema import).+currentModuleText :: T.Text+currentModuleText =+  T.unlines+    [ "let S =",+      "      https://raw.githubusercontent.com/shinzui/seihou-schema/abc123/package.dhall",+      "        sha256:0000000000000000000000000000000000000000000000000000000000000000",+      "",+      "in  S.Module::{",+      "    , name = \"current-module\"",+      "    , version = None Text",+      "    , description = Some \"Fully current module\"",+      "    , vars = [] : List { name : Text, type : Text, default : Optional Text, description : Optional Text, required : Bool, validation : Optional Text }",+      "    , exports = [] : List { var : Text, alias : Optional Text }",+      "    , prompts = [] : List { var : Text, text : Text, when : Optional Text, choices : Optional (List Text) }",+      "    , steps =",+      "      [ { strategy = \"template\"",+      "        , src = \"foo.tpl\"",+      "        , dest = \"foo\"",+      "        , when = None Text",+      "        , patch = None Text",+      "        }",+      "      ]",+      "    , commands = [] : List { run : Text, workDir : Optional Text, when : Optional Text }",+      "    , dependencies = [] : List { module : Text, vars : List { name : Text, value : Text } }",+      "    , migrations = [] : List S.Migration.Type",+      "    }"+    ]++-- | A module missing only version (has patch and commands).+missingVersionOnlyText :: T.Text+missingVersionOnlyText =+  T.unlines+    [ "{ name = \"no-version\"",+      ", description = Some \"Missing version only\"",+      ", vars = [] : List { name : Text, type : Text, default : Optional Text, description : Optional Text, required : Bool, validation : Optional Text }",+      ", exports = [] : List { var : Text, alias : Optional Text }",+      ", prompts = [] : List { var : Text, text : Text, when : Optional Text, choices : Optional (List Text) }",+      ", steps = [] : List { strategy : Text, src : Text, dest : Text, when : Optional Text, patch : Optional Text }",+      ", commands = [] : List { run : Text, workDir : Optional Text, when : Optional Text }",+      ", dependencies = [] : List { module : Text, vars : List { name : Text, value : Text } }",+      "}"+    ]++-- | A module with multiple steps, some missing patch.+multiStepText :: T.Text+multiStepText =+  T.unlines+    [ "{ name = \"multi-step\"",+      ", version = None Text",+      ", description = None Text",+      ", vars = [] : List { name : Text, type : Text, default : Optional Text, description : Optional Text, required : Bool, validation : Optional Text }",+      ", exports = [] : List { var : Text, alias : Optional Text }",+      ", prompts = [] : List { var : Text, text : Text, when : Optional Text, choices : Optional (List Text) }",+      ", steps =",+      "  [ { strategy = \"copy\"",+      "    , src = \"a\"",+      "    , dest = \"a\"",+      "    , when = None Text",+      "    }",+      "  , { strategy = \"template\"",+      "    , src = \"b.tpl\"",+      "    , dest = \"b\"",+      "    , when = None Text",+      "    , patch = None Text",+      "    }",+      "  , { strategy = \"copy\"",+      "    , src = \"c\"",+      "    , dest = \"c\"",+      "    , when = None Text",+      "    }",+      "  ]",+      ", commands = [] : List { run : Text, workDir : Optional Text, when : Optional Text }",+      ", dependencies = [] : List { module : Text, vars : List { name : Text, value : Text } }",+      "}"+    ]++spec :: Spec+spec = do+  describe "detectIssues" $ do+    it "detects all issues in an old module" $ do+      let issues = detectIssues testUrl oldModuleText+      issues `shouldContain` [MissingVersion]+      issues `shouldContain` [MissingCommands]+      issues `shouldContain` [MissingStepPatch 0]+      issues `shouldContain` [BareStringDepTypeAnnotation]+      issues `shouldContain` [MissingSchemaImport]+      issues `shouldContain` [MissingMigrations]++    it "returns empty list for a current module" $ do+      detectIssues testUrl currentModuleText `shouldBe` []++    it "detects missing version, schema import, and migrations when other fields present" $ do+      detectIssues testUrl missingVersionOnlyText+        `shouldBe` [MissingVersion, MissingSchemaImport, MissingMigrations]++    it "detects bare string dependencies" $ do+      let issues = detectIssues testUrl bareStringDepsText+      issues `shouldContain` [BareStringDep "haskell-base"]+      issues `shouldContain` [BareStringDep "nix-flake"]++    it "detects missing patch only on steps that lack it" $ do+      let issues = detectIssues testUrl multiStepText+      issues `shouldContain` [MissingStepPatch 0]+      issues `shouldContain` [MissingStepPatch 2]+      issues `shouldNotContain` [MissingStepPatch 1]++  describe "upgradeModuleText" $ do+    it "returns AlreadyCurrent for a current module" $ do+      upgradeModuleText testUrl testHash currentModuleText `shouldBe` AlreadyCurrent++    it "inserts version field after name" $ do+      case upgradeModuleText testUrl testHash missingVersionOnlyText of+        Upgraded text _ -> do+          T.isInfixOf ", version = None Text" text `shouldBe` True+          -- version should appear after name and before description+          let ls = T.lines text+              nameIdx = findIndex (T.isInfixOf "{ name =") ls+              versionIdx = findIndex (T.isInfixOf ", version =") ls+              descIdx = findIndex (T.isInfixOf ", description =") ls+          case (nameIdx, versionIdx, descIdx) of+            (Just n, Just v, Just d) -> do+              v `shouldBe` n + 1+              d `shouldSatisfy` (> v)+            _ -> expectationFailure "could not find expected fields"+        AlreadyCurrent -> expectationFailure "expected Upgraded"++    it "inserts commands field" $ do+      case upgradeModuleText testUrl testHash oldModuleText of+        Upgraded text _ ->+          T.isInfixOf ", commands =" text `shouldBe` True+        AlreadyCurrent -> expectationFailure "expected Upgraded"++    it "inserts patch in steps that lack it" $ do+      case upgradeModuleText testUrl testHash multiStepText of+        Upgraded text _ -> do+          -- Should have 3 occurrences of patch now (step 1 already had it)+          let patchCount = length (filter (T.isInfixOf ", patch =") (T.lines text))+          patchCount `shouldBe` 3+        AlreadyCurrent -> expectationFailure "expected Upgraded"++    it "converts bare string deps to record form" $ do+      case upgradeModuleText testUrl testHash bareStringDepsText of+        Upgraded text _ -> do+          T.isInfixOf "{ module = \"haskell-base\"" text `shouldBe` True+          T.isInfixOf "{ module = \"nix-flake\"" text `shouldBe` True+          -- The old bare format "haskell-base", "nix-flake" should be gone+          T.isInfixOf "\"haskell-base\", \"nix-flake\"" text `shouldBe` False+        AlreadyCurrent -> expectationFailure "expected Upgraded"++    it "converts List Text annotation to record type" $ do+      case upgradeModuleText testUrl testHash oldModuleText of+        Upgraded text _ -> do+          -- The dependencies line should no longer use "[] : List Text"+          T.isInfixOf "[] : List Text" text `shouldBe` False+          -- It should use the record type annotation instead+          T.isInfixOf "List { module : Text" text `shouldBe` True+        AlreadyCurrent -> expectationFailure "expected Upgraded"++    it "is idempotent" $ do+      case upgradeModuleText testUrl testHash oldModuleText of+        Upgraded text _ ->+          upgradeModuleText testUrl testHash text `shouldBe` AlreadyCurrent+        AlreadyCurrent -> expectationFailure "expected first upgrade to produce changes"++    it "injects schema import into legacy module" $ do+      case upgradeModuleText testUrl testHash oldModuleText of+        Upgraded text _ -> do+          T.isInfixOf "let S =" text `shouldBe` True+          T.isInfixOf "seihou-schema" text `shouldBe` True+          T.isInfixOf "S.Module::" text `shouldBe` True+        AlreadyCurrent -> expectationFailure "expected Upgraded"++    it "inserts migrations field" $ do+      case upgradeModuleText testUrl testHash missingVersionOnlyText of+        Upgraded text _ ->+          T.isInfixOf ", migrations =" text `shouldBe` True+        AlreadyCurrent -> expectationFailure "expected Upgraded"++  describe "issueMessage" $ do+    it "produces human-readable messages" $ do+      issueMessage MissingVersion `shouldBe` "missing field: version"+      issueMessage (MissingStepPatch 0) `shouldBe` "missing field: patch (in step 1)"+      issueMessage MissingCommands `shouldBe` "missing field: commands"+      issueMessage (BareStringDep "foo") `shouldBe` "bare string dependency: foo"+      issueMessage MissingMigrations `shouldBe` "missing field: migrations"+  where+    findIndex p xs = go 0 xs+      where+        go _ [] = Nothing+        go i (x : rest')+          | p x = Just i+          | otherwise = go (i + 1) rest'
+ test/Seihou/Core/StatusSpec.hs view
@@ -0,0 +1,111 @@+module Seihou.Core.StatusSpec (tests) where++import Data.Map.Strict qualified as Map+import Data.Text (Text)+import Data.Time (UTCTime, defaultTimeLocale, parseTimeOrError)+import Effectful+import Seihou.Core.Status (computeTrackedFileStatuses)+import Seihou.Core.Types+import Seihou.Effect.FilesystemPure (PureFS (..), emptyFS, runFilesystemPure)+import Seihou.Manifest.Hash (hashContent)+import Seihou.Manifest.Types (emptyManifest)+import Test.Hspec+import Test.Tasty+import Test.Tasty.Hspec (testSpec)++tests :: IO TestTree+tests = testSpec "Seihou.Core.Status" spec++fixedTime :: UTCTime+fixedTime = parseTimeOrError True defaultTimeLocale "%Y-%m-%dT%H:%M:%SZ" "2026-03-01T10:30:00Z"++modName :: ModuleName+modName = ModuleName "test-module"++mkRecord :: Text -> FileRecord+mkRecord content =+  FileRecord+    { hash = hashContent content,+      moduleName = modName,+      strategy = Template,+      generatedAt = fixedTime+    }++runStatus :: PureFS -> Manifest -> [TrackedFile]+runStatus fs manifest =+  fst $ runPureEff $ runFilesystemPure fs $ computeTrackedFileStatuses manifest++spec :: Spec+spec = do+  describe "computeTrackedFileStatuses" $ do+    it "classifies a file matching its manifest hash as TfsUnchanged" $ do+      let content = "# Hello World"+          manifest =+            (emptyManifest fixedTime :: Manifest)+              { files = Map.singleton "README.md" (mkRecord content)+              }+          fs = PureFS (Map.singleton "README.md" content) mempty+          result = runStatus fs manifest+      length result `shouldBe` 1+      (head result).path `shouldBe` "README.md"+      (head result).moduleName `shouldBe` modName+      (head result).status `shouldBe` TfsUnchanged++    it "classifies a file with different disk content as TfsModified" $ do+      let originalContent = "# Hello"+          modifiedContent = "# Hello - edited"+          manifest =+            (emptyManifest fixedTime :: Manifest)+              { files = Map.singleton "README.md" (mkRecord originalContent)+              }+          fs = PureFS (Map.singleton "README.md" modifiedContent) mempty+          result = runStatus fs manifest+      length result `shouldBe` 1+      (head result).status `shouldBe` TfsModified++    it "classifies a file missing from disk as TfsDeleted" $ do+      let content = "# Hello"+          manifest =+            (emptyManifest fixedTime :: Manifest)+              { files = Map.singleton "README.md" (mkRecord content)+              }+          result = runStatus emptyFS manifest+      length result `shouldBe` 1+      (head result).status `shouldBe` TfsDeleted++    it "handles mixed statuses across multiple files" $ do+      let unchangedContent = "unchanged"+          modifiedOriginal = "original"+          modifiedCurrent = "edited"+          deletedContent = "deleted"+          manifest =+            (emptyManifest fixedTime :: Manifest)+              { files =+                  Map.fromList+                    [ ("a.txt", mkRecord unchangedContent),+                      ("b.txt", mkRecord modifiedOriginal),+                      ("c.txt", mkRecord deletedContent)+                    ]+              }+          fs =+            PureFS+              ( Map.fromList+                  [ ("a.txt", unchangedContent),+                    ("b.txt", modifiedCurrent)+                  ]+              )+              mempty+          result = runStatus fs manifest+      length result `shouldBe` 3+      -- Results are sorted by path+      (result !! 0).path `shouldBe` "a.txt"+      (result !! 0).status `shouldBe` TfsUnchanged+      (result !! 1).path `shouldBe` "b.txt"+      (result !! 1).status `shouldBe` TfsModified+      (result !! 2).path `shouldBe` "c.txt"+      (result !! 2).status `shouldBe` TfsDeleted++    it "returns empty list for empty manifest" $ do+      let manifest = emptyManifest fixedTime+          result = runStatus emptyFS manifest+      result `shouldBe` []
+ test/Seihou/Core/TypesSpec.hs view
@@ -0,0 +1,153 @@+module Seihou.Core.TypesSpec (tests) where++import Seihou.Core.Types+import Test.Hspec+import Test.Tasty+import Test.Tasty.Hspec (testSpec)++tests :: IO TestTree+tests = testSpec "Seihou.Core.Types" spec++spec :: Spec+spec = do+  describe "ModuleName" $ do+    it "supports OverloadedStrings" $ do+      let name = "my-module" :: ModuleName+      name.unModuleName `shouldBe` "my-module"++    it "supports Eq" $ do+      ("a" :: ModuleName) `shouldBe` ("a" :: ModuleName)+      ("a" :: ModuleName) `shouldNotBe` ("b" :: ModuleName)++    it "supports Show" $ do+      show ("test" :: ModuleName) `shouldNotBe` ""++  describe "VarName" $ do+    it "supports OverloadedStrings" $ do+      let name = "project.name" :: VarName+      name.unVarName `shouldBe` "project.name"++  describe "VarType" $ do+    it "has five distinct constructors" $ do+      VTText `shouldNotBe` VTBool+      VTBool `shouldNotBe` VTInt+      VTInt `shouldNotBe` VTList VTText+      VTList VTText `shouldNotBe` VTChoice ["a"]++  describe "VarValue" $ do+    it "supports Text values" $ do+      VText "hello" `shouldBe` VText "hello"++    it "supports Bool values" $ do+      VBool True `shouldNotBe` VBool False++    it "supports Int values" $ do+      VInt 42 `shouldBe` VInt 42++    it "supports List values" $ do+      VList [VText "a", VText "b"] `shouldBe` VList [VText "a", VText "b"]++  describe "VarDecl" $ do+    it "can be constructed with all fields" $ do+      let decl =+            VarDecl+              { name = "project.name",+                type_ = VTText,+                default_ = Just (VText "my-app"),+                description = Just "Name of the project",+                required = True,+                validation = Just (ValPattern "[a-z][a-z0-9-]*")+              }+      decl.required `shouldBe` True++  describe "Strategy" $ do+    it "has four distinct constructors" $ do+      Copy `shouldNotBe` Template+      Template `shouldNotBe` DhallText+      DhallText `shouldNotBe` Structured++  describe "Module" $ do+    it "can be constructed with all fields" $ do+      let m =+            Module+              { name = "haskell-base",+                version = Nothing,+                description = Just "A Haskell project template",+                vars = [],+                exports = [],+                prompts = [],+                steps = [],+                commands = [],+                dependencies = [],+                removal = Nothing,+                migrations = []+              }+      m.name `shouldBe` "haskell-base"++    it "supports Eq for identical values" $ do+      let m =+            Module+              { name = "test",+                version = Nothing,+                description = Nothing,+                vars = [],+                exports = [],+                prompts = [],+                steps = [],+                commands = [],+                dependencies = [],+                removal = Nothing,+                migrations = []+              }+      m `shouldBe` m++    it "supports Show" $ do+      let m =+            Module+              { name = "test",+                version = Nothing,+                description = Nothing,+                vars = [],+                exports = [],+                prompts = [],+                steps = [],+                commands = [],+                dependencies = [],+                removal = Nothing,+                migrations = []+              }+      show m `shouldNotBe` ""++  describe "Operation" $ do+    it "supports WriteFileOp" $ do+      let op = WriteFileOp {dest = "README.md", content = "# Hello", strategy = Template}+      op.dest `shouldBe` "README.md"++    it "supports CreateDirOp" $ do+      let op = CreateDirOp {path = "src"}+      op.path `shouldBe` "src"++    it "supports CopyFileOp" $ do+      let op = CopyFileOp {src = "a.txt", dest = "b.txt"}+      op.src `shouldBe` "a.txt"++    it "supports RunCommandOp" $ do+      let op = RunCommandOp {command = "git init", workDir = Nothing}+      op.command `shouldBe` "git init"++  describe "Expr" $ do+    it "supports ExprIsSet" $ do+      ExprIsSet "x" `shouldBe` ExprIsSet "x"++    it "supports logical operations" $ do+      let expr = ExprAnd (ExprIsSet "a") (ExprNot (ExprLit False))+      expr `shouldBe` expr++    it "supports ExprEq" $ do+      ExprEq "x" (VText "hello") `shouldBe` ExprEq "x" (VText "hello")++  describe "Manifest" $ do+    it "has a version field" $ do+      -- Verify the Manifest type is a record with expected fields+      let hash = SHA256 "abc"+      hash.unSHA256 `shouldBe` "abc"
+ test/Seihou/Core/VariableSpec.hs view
@@ -0,0 +1,779 @@+module Seihou.Core.VariableSpec (tests) where++import Data.Map.Strict qualified as Map+import Data.Text qualified as T+import Seihou.Core.Expr (evalExpr, parseExpr)+import Seihou.Core.Types+import Seihou.Core.Variable+import Test.Hspec+import Test.Tasty+import Test.Tasty.Hspec (testSpec)++tests :: IO TestTree+tests = testSpec "Seihou.Core.Variable" spec++-- | Helper to build a simple text var declaration.+textVar :: VarName -> Bool -> Maybe VarValue -> Maybe Validation -> VarDecl+textVar name req def val =+  VarDecl+    { name = name,+      type_ = VTText,+      default_ = def,+      description = Nothing,+      required = req,+      validation = val+    }++-- | Helper to build a bool var declaration.+boolVar :: VarName -> Bool -> Maybe VarValue -> VarDecl+boolVar name req def =+  VarDecl+    { name = name,+      type_ = VTBool,+      default_ = def,+      description = Nothing,+      required = req,+      validation = Nothing+    }++-- | Helper to build an int var declaration.+intVar :: VarName -> Bool -> Maybe VarValue -> Maybe Validation -> VarDecl+intVar name req def val =+  VarDecl+    { name = name,+      type_ = VTInt,+      default_ = def,+      description = Nothing,+      required = req,+      validation = val+    }++-- | Helper to build a choice var declaration.+choiceVar :: VarName -> Bool -> [T.Text] -> Maybe VarValue -> VarDecl+choiceVar name req options def =+  VarDecl+    { name = name,+      type_ = VTChoice options,+      default_ = def,+      description = Nothing,+      required = req,+      validation = Nothing+    }++spec :: Spec+spec = do+  describe "envVarName" $ do+    it "converts project.name to SEIHOU_VAR_PROJECT_NAME" $ do+      envVarName "project.name" `shouldBe` "SEIHOU_VAR_PROJECT_NAME"++    it "converts license to SEIHOU_VAR_LICENSE" $ do+      envVarName "license" `shouldBe` "SEIHOU_VAR_LICENSE"++    it "converts project.version to SEIHOU_VAR_PROJECT_VERSION" $ do+      envVarName "project.version" `shouldBe` "SEIHOU_VAR_PROJECT_VERSION"++  describe "coerceValue" $ do+    it "coerces text as-is" $ do+      coerceValue "x" VTText "hello" `shouldBe` Right (VText "hello")++    it "coerces true string to VBool True" $ do+      coerceValue "x" VTBool "true" `shouldBe` Right (VBool True)++    it "coerces yes string to VBool True" $ do+      coerceValue "x" VTBool "yes" `shouldBe` Right (VBool True)++    it "coerces 1 string to VBool True" $ do+      coerceValue "x" VTBool "1" `shouldBe` Right (VBool True)++    it "coerces false string to VBool False" $ do+      coerceValue "x" VTBool "false" `shouldBe` Right (VBool False)++    it "coerces no string to VBool False" $ do+      coerceValue "x" VTBool "no" `shouldBe` Right (VBool False)++    it "rejects invalid bool string" $ do+      coerceValue "x" VTBool "maybe" `shouldBe` Left (CoercionFailed "x" VTBool "maybe")++    it "coerces integer string" $ do+      coerceValue "x" VTInt "42" `shouldBe` Right (VInt 42)++    it "coerces negative integer" $ do+      coerceValue "x" VTInt "-5" `shouldBe` Right (VInt (-5))++    it "rejects non-integer string" $ do+      coerceValue "x" VTInt "abc" `shouldBe` Left (CoercionFailed "x" VTInt "abc")++    it "coerces comma-separated list" $ do+      coerceValue "x" (VTList VTText) "a,b,c"+        `shouldBe` Right (VList [VText "a", VText "b", VText "c"])++    it "strips whitespace in list elements" $ do+      coerceValue "x" (VTList VTText) "a , b , c"+        `shouldBe` Right (VList [VText "a", VText "b", VText "c"])++    it "coerces valid choice" $ do+      coerceValue "x" (VTChoice ["MIT", "BSD3", "Apache"]) "MIT"+        `shouldBe` Right (VText "MIT")++    it "rejects invalid choice" $ do+      coerceValue "x" (VTChoice ["MIT", "BSD3"]) "GPL"+        `shouldBe` Left (CoercionFailed "x" (VTChoice ["MIT", "BSD3"]) "GPL")++  describe "coerceDefault" $ do+    it "coerces a raw-text bool default to VBool" $ do+      coerceDefault "x" VTBool (VText "true") `shouldBe` Right (VBool True)++    it "coerces a raw-text int default to VInt" $ do+      coerceDefault "x" VTInt (VText "42") `shouldBe` Right (VInt 42)++    it "keeps a text default as VText" $ do+      coerceDefault "x" VTText (VText "hello") `shouldBe` Right (VText "hello")++    it "validates a constrained choice default" $ do+      coerceDefault "x" (VTChoice ["MIT", "BSD3"]) (VText "MIT")+        `shouldBe` Right (VText "MIT")++    it "keeps an unconstrained (empty) choice default as VText" $ do+      coerceDefault "x" (VTChoice []) (VText "MIT") `shouldBe` Right (VText "MIT")++    it "passes an already-typed default through unchanged" $ do+      coerceDefault "x" VTBool (VBool True) `shouldBe` Right (VBool True)++    it "fails on a malformed bool default" $ do+      coerceDefault "x" VTBool (VText "treu")+        `shouldBe` Left (CoercionFailed "x" VTBool "treu")++  describe "validateVarValue" $ do+    it "passes when no validation is set" $ do+      let decl = textVar "x" True Nothing Nothing+      validateVarValue decl (VText "anything") `shouldBe` Right ()++    it "passes pattern validation" $ do+      let decl = textVar "x" True Nothing (Just (ValPattern "[a-z][a-z0-9-]*"))+      validateVarValue decl (VText "my-app") `shouldBe` Right ()++    it "rejects pattern validation" $ do+      let decl = textVar "x" True Nothing (Just (ValPattern "[a-z][a-z0-9-]*"))+      case validateVarValue decl (VText "MyApp") of+        Left (ValidationFailed _ _) -> pure ()+        other -> expectationFailure ("Expected ValidationFailed, got: " <> show other)++    it "passes range validation" $ do+      let decl = intVar "x" True Nothing (Just (ValRange 1 100))+      validateVarValue decl (VInt 50) `shouldBe` Right ()++    it "rejects out-of-range value" $ do+      let decl = intVar "x" True Nothing (Just (ValRange 1 100))+      case validateVarValue decl (VInt 200) of+        Left (ValidationFailed _ _) -> pure ()+        other -> expectationFailure ("Expected ValidationFailed, got: " <> show other)++    it "passes min-length validation" $ do+      let decl = textVar "x" True Nothing (Just (ValMinLength 3))+      validateVarValue decl (VText "hello") `shouldBe` Right ()++    it "rejects too-short value" $ do+      let decl = textVar "x" True Nothing (Just (ValMinLength 3))+      case validateVarValue decl (VText "ab") of+        Left (ValidationFailed _ _) -> pure ()+        other -> expectationFailure ("Expected ValidationFailed, got: " <> show other)++    it "passes max-length validation" $ do+      let decl = textVar "x" True Nothing (Just (ValMaxLength 5))+      validateVarValue decl (VText "hello") `shouldBe` Right ()++    it "rejects too-long value" $ do+      let decl = textVar "x" True Nothing (Just (ValMaxLength 3))+      case validateVarValue decl (VText "hello") of+        Left (ValidationFailed _ _) -> pure ()+        other -> expectationFailure ("Expected ValidationFailed, got: " <> show other)++  describe "resolveVariables" $ do+    it "resolves from CLI overrides" $ do+      let decls = [textVar "project.name" True Nothing Nothing]+          cli = Map.fromList [("project.name", "my-app")]+          env = Map.empty+      case resolveVariables decls cli env "" "" Map.empty Map.empty Map.empty Map.empty Map.empty of+        Right resolved -> do+          let rv = resolved Map.! "project.name"+          rv.value `shouldBe` VText "my-app"+          rv.source `shouldBe` FromCLI+        Left errs -> expectationFailure ("Expected Right, got: " <> show errs)++    it "resolves from environment variables" $ do+      let decls = [textVar "project.name" True Nothing Nothing]+          cli = Map.empty+          env = Map.fromList [("SEIHOU_VAR_PROJECT_NAME", "env-app")]+      case resolveVariables decls cli env "" "" Map.empty Map.empty Map.empty Map.empty Map.empty of+        Right resolved -> do+          let rv = resolved Map.! "project.name"+          rv.value `shouldBe` VText "env-app"+          rv.source `shouldBe` FromEnv "SEIHOU_VAR_PROJECT_NAME"+        Left errs -> expectationFailure ("Expected Right, got: " <> show errs)++    it "resolves from module defaults" $ do+      let decls = [textVar "project.version" False (Just (VText "0.1.0.0")) Nothing]+          cli = Map.empty+          env = Map.empty+      case resolveVariables decls cli env "" "" Map.empty Map.empty Map.empty Map.empty Map.empty of+        Right resolved -> do+          let rv = resolved Map.! "project.version"+          rv.value `shouldBe` VText "0.1.0.0"+          rv.source `shouldBe` FromDefault+        Left errs -> expectationFailure ("Expected Right, got: " <> show errs)++    it "rejects missing required variable" $ do+      let decls = [textVar "project.name" True Nothing Nothing]+          cli = Map.empty+          env = Map.empty+      case resolveVariables decls cli env "" "" Map.empty Map.empty Map.empty Map.empty Map.empty of+        Left errs -> errs `shouldBe` [MissingRequiredVar "project.name"]+        Right _ -> expectationFailure "Expected Left"++    it "CLI override beats environment variable" $ do+      let decls = [textVar "project.name" True Nothing Nothing]+          cli = Map.fromList [("project.name", "cli-app")]+          env = Map.fromList [("SEIHOU_VAR_PROJECT_NAME", "env-app")]+      case resolveVariables decls cli env "" "" Map.empty Map.empty Map.empty Map.empty Map.empty of+        Right resolved -> do+          (.value) (resolved Map.! "project.name") `shouldBe` VText "cli-app"+          (.source) (resolved Map.! "project.name") `shouldBe` FromCLI+        Left errs -> expectationFailure ("Expected Right, got: " <> show errs)++    it "environment variable beats module default" $ do+      let decls = [textVar "project.name" True (Just (VText "default-app")) Nothing]+          cli = Map.empty+          env = Map.fromList [("SEIHOU_VAR_PROJECT_NAME", "env-app")]+      case resolveVariables decls cli env "" "" Map.empty Map.empty Map.empty Map.empty Map.empty of+        Right resolved -> do+          (.value) (resolved Map.! "project.name") `shouldBe` VText "env-app"+          (.source) (resolved Map.! "project.name") `shouldBe` FromEnv "SEIHOU_VAR_PROJECT_NAME"+        Left errs -> expectationFailure ("Expected Right, got: " <> show errs)++    it "CLI override beats module default" $ do+      let decls = [textVar "project.name" True (Just (VText "default-app")) Nothing]+          cli = Map.fromList [("project.name", "cli-app")]+          env = Map.empty+      case resolveVariables decls cli env "" "" Map.empty Map.empty Map.empty Map.empty Map.empty of+        Right resolved ->+          (.value) (resolved Map.! "project.name") `shouldBe` VText "cli-app"+        Left errs -> expectationFailure ("Expected Right, got: " <> show errs)++    it "resolves multiple variables with mixed sources" $ do+      let decls =+            [ textVar "project.name" True Nothing Nothing,+              textVar "project.version" False (Just (VText "0.1.0.0")) Nothing,+              textVar "license" False (Just (VText "MIT")) Nothing+            ]+          cli = Map.fromList [("project.name", "my-app")]+          env = Map.fromList [("SEIHOU_VAR_LICENSE", "BSD3")]+      case resolveVariables decls cli env "" "" Map.empty Map.empty Map.empty Map.empty Map.empty of+        Right resolved -> do+          (.value) (resolved Map.! "project.name") `shouldBe` VText "my-app"+          (.source) (resolved Map.! "project.name") `shouldBe` FromCLI+          (.value) (resolved Map.! "project.version") `shouldBe` VText "0.1.0.0"+          (.source) (resolved Map.! "project.version") `shouldBe` FromDefault+          (.value) (resolved Map.! "license") `shouldBe` VText "BSD3"+          (.source) (resolved Map.! "license") `shouldBe` FromEnv "SEIHOU_VAR_LICENSE"+        Left errs -> expectationFailure ("Expected Right, got: " <> show errs)++    it "coerces CLI bool override" $ do+      let decls = [boolVar "enable.tests" True Nothing]+          cli = Map.fromList [("enable.tests", "true")]+          env = Map.empty+      case resolveVariables decls cli env "" "" Map.empty Map.empty Map.empty Map.empty Map.empty of+        Right resolved ->+          (.value) (resolved Map.! "enable.tests") `shouldBe` VBool True+        Left errs -> expectationFailure ("Expected Right, got: " <> show errs)++    it "coerces env int override" $ do+      let decls = [intVar "port" True Nothing Nothing]+          cli = Map.empty+          env = Map.fromList [("SEIHOU_VAR_PORT", "8080")]+      case resolveVariables decls cli env "" "" Map.empty Map.empty Map.empty Map.empty Map.empty of+        Right resolved ->+          (.value) (resolved Map.! "port") `shouldBe` VInt 8080+        Left errs -> expectationFailure ("Expected Right, got: " <> show errs)++    it "returns coercion error for bad int" $ do+      let decls = [intVar "port" True Nothing Nothing]+          cli = Map.fromList [("port", "abc")]+          env = Map.empty+      case resolveVariables decls cli env "" "" Map.empty Map.empty Map.empty Map.empty Map.empty of+        Left errs -> errs `shouldBe` [CoercionFailed "port" VTInt "abc"]+        Right _ -> expectationFailure "Expected Left"++    it "validates after coercion" $ do+      let decls = [textVar "project.name" True Nothing (Just (ValPattern "[a-z][a-z0-9-]*"))]+          cli = Map.fromList [("project.name", "MyBad")]+          env = Map.empty+      case resolveVariables decls cli env "" "" Map.empty Map.empty Map.empty Map.empty Map.empty of+        Left (err : _) -> case err of+          ValidationFailed _ _ -> pure ()+          other -> expectationFailure ("Expected ValidationFailed, got: " <> show other)+        Left [] -> expectationFailure "Expected non-empty error list"+        Right _ -> expectationFailure "Expected Left"++    it "resolves choice variable from CLI" $ do+      let decls = [choiceVar "license" True ["MIT", "BSD3", "Apache"] Nothing]+          cli = Map.fromList [("license", "MIT")]+          env = Map.empty+      case resolveVariables decls cli env "" "" Map.empty Map.empty Map.empty Map.empty Map.empty of+        Right resolved ->+          (.value) (resolved Map.! "license") `shouldBe` VText "MIT"+        Left errs -> expectationFailure ("Expected Right, got: " <> show errs)++    it "coerces a raw-text bool default to VBool when falling through to default" $ do+      -- Mirrors the Dhall decode of @default = Some "true"@ on a @bool@ var:+      -- the default reaches resolution as 'VText' and must arrive typed.+      let decls = [boolVar "feature.on" False (Just (VText "true"))]+          cli = Map.empty+          env = Map.empty+      case resolveVariables decls cli env "" "" Map.empty Map.empty Map.empty Map.empty Map.empty of+        Right resolved -> do+          (.value) (resolved Map.! "feature.on") `shouldBe` VBool True+          (.source) (resolved Map.! "feature.on") `shouldBe` FromDefault+        Left errs -> expectationFailure ("Expected Right, got: " <> show errs)++    it "coerces a raw-text int default to VInt when falling through to default" $ do+      let decls = [intVar "retries" False (Just (VText "3")) Nothing]+          cli = Map.empty+          env = Map.empty+      case resolveVariables decls cli env "" "" Map.empty Map.empty Map.empty Map.empty Map.empty of+        Right resolved ->+          (.value) (resolved Map.! "retries") `shouldBe` VInt 3+        Left errs -> expectationFailure ("Expected Right, got: " <> show errs)++    it "errors when a bool default cannot be coerced" $ do+      let decls = [boolVar "feature.on" False (Just (VText "treu"))]+          cli = Map.empty+          env = Map.empty+      case resolveVariables decls cli env "" "" Map.empty Map.empty Map.empty Map.empty Map.empty of+        Left errs -> errs `shouldBe` [CoercionFailed "feature.on" VTBool "treu"]+        Right _ -> expectationFailure "Expected Left"++    it "re-coerces a manifest-round-tripped bool value to VBool" $ do+      -- The manifest stores resolved variables as raw text (a 'VBool' is+      -- serialized to "true"). On a re-run such a value can only re-enter+      -- resolution through a config-style 'Map VarName Text' source, which+      -- routes through 'coerceValue' — so a stored bool round-trips back to+      -- 'VBool', never reaching evaluation as 'VText "true"'.+      let manifestStoredText = "true" -- i.e. varValueToText (VBool True)+          decls = [boolVar "feature.on" True Nothing]+          cli = Map.empty+          env = Map.empty+          local = Map.fromList [("feature.on", manifestStoredText)]+      case resolveVariables decls cli env "" "" local Map.empty Map.empty Map.empty Map.empty of+        Right resolved ->+          (.value) (resolved Map.! "feature.on") `shouldBe` VBool True+        Left errs -> expectationFailure ("Expected Right, got: " <> show errs)++    it "Eq <var> true evaluates True for a defaulted bool" $ do+      -- The end-to-end bug: a bool default must make @Eq feature.on true@ match.+      let decls = [boolVar "feature.on" False (Just (VText "true"))]+          cli = Map.empty+          env = Map.empty+      case resolveVariables decls cli env "" "" Map.empty Map.empty Map.empty Map.empty Map.empty of+        Right resolved -> do+          let varMap = Map.map (.value) resolved+          case parseExpr "Eq feature.on true" of+            Right expr -> evalExpr varMap expr `shouldBe` True+            Left err -> expectationFailure ("Expected parse, got: " <> show err)+        Left errs -> expectationFailure ("Expected Right, got: " <> show errs)++  describe "formatExplain" $ do+    it "formats a provenance report with bracket notation" $ do+      let decl1 = textVar "project.name" True Nothing Nothing+          decl2 = textVar "project.version" False (Just (VText "0.1.0.0")) Nothing+          resolved =+            Map.fromList+              [ ("project.name", ResolvedVar (VText "my-app") FromCLI decl1),+                ("project.version", ResolvedVar (VText "0.1.0.0") FromDefault decl2)+              ]+          output = formatExplain resolved+      T.isInfixOf "project.name" output `shouldBe` True+      T.isInfixOf "\"my-app\"" output `shouldBe` True+      T.isInfixOf "[--var]" output `shouldBe` True+      T.isInfixOf "project.version" output `shouldBe` True+      T.isInfixOf "\"0.1.0.0\"" output `shouldBe` True+      T.isInfixOf "[default]" output `shouldBe` True++    it "formats env source with bracket notation" $ do+      let decl = textVar "license" True Nothing Nothing+          resolved =+            Map.fromList+              [("license", ResolvedVar (VText "MIT") (FromEnv "SEIHOU_VAR_LICENSE") decl)]+          output = formatExplain resolved+      T.isInfixOf "[env SEIHOU_VAR_LICENSE]" output `shouldBe` True++    it "formats local config source with bracket notation" $ do+      let decl = textVar "license" True Nothing Nothing+          resolved =+            Map.fromList+              [("license", ResolvedVar (VText "MIT") FromLocalConfig decl)]+          output = formatExplain resolved+      T.isInfixOf "[local config]" output `shouldBe` True++    it "formats namespace config source with bracket notation" $ do+      let decl = textVar "haskell.ghc" True Nothing Nothing+          resolved =+            Map.fromList+              [("haskell.ghc", ResolvedVar (VText "9.12.2") (FromNamespaceConfig "haskell") decl)]+          output = formatExplain resolved+      T.isInfixOf "[namespace: haskell]" output `shouldBe` True++    it "formats context config source with bracket notation" $ do+      let decl = textVar "user.email" True Nothing Nothing+          resolved =+            Map.fromList+              [("user.email", ResolvedVar (VText "me@work.com") (FromContextConfig "work") decl)]+          output = formatExplain resolved+      T.isInfixOf "[context: work]" output `shouldBe` True++    it "formats global config source with bracket notation" $ do+      let decl = textVar "license" True Nothing Nothing+          resolved =+            Map.fromList+              [("license", ResolvedVar (VText "MIT") FromGlobalConfig decl)]+          output = formatExplain resolved+      T.isInfixOf "[global config]" output `shouldBe` True++    it "formats parent source with bracket notation" $ do+      let decl = textVar "skill.name" True Nothing Nothing+          resolved =+            Map.fromList+              [("skill.name", ResolvedVar (VText "exec-plan") (FromParent "exec-plan") decl)]+          output = formatExplain resolved+      T.isInfixOf "[parent: exec-plan]" output `shouldBe` True++    it "uses 2-space indentation" $ do+      let decl = textVar "license" True Nothing Nothing+          resolved =+            Map.fromList+              [("license", ResolvedVar (VText "MIT") FromCLI decl)]+          output = formatExplain resolved+      T.isInfixOf "  license" output `shouldBe` True++  describe "formatDeclarations" $ do+    it "formats required variables without defaults" $ do+      let decls = [VarDecl "project.name" VTText Nothing (Just "Name") True Nothing]+          output = formatDeclarations decls+      T.isInfixOf "project.name" output `shouldBe` True+      T.isInfixOf "(required, no default)" output `shouldBe` True++    it "formats variables with default values" $ do+      let decls = [VarDecl "project.version" VTText (Just (VText "0.1.0.0")) Nothing False Nothing]+          output = formatDeclarations decls+      T.isInfixOf "\"0.1.0.0\"" output `shouldBe` True+      T.isInfixOf "(required, no default)" output `shouldBe` False++    it "formats variables with defaults using = sign" $ do+      let decls =+            [ VarDecl+                { name = "project.version",+                  type_ = VTText,+                  default_ = Just (VText "0.1.0.0"),+                  description = Nothing,+                  required = False,+                  validation = Nothing+                }+            ]+          output = formatDeclarations decls+      T.isInfixOf "project.version" output `shouldBe` True+      T.isInfixOf "= \"0.1.0.0\"" output `shouldBe` True++    it "aligns columns for multiple variables" $ do+      let decls =+            [ VarDecl "project.name" VTText Nothing (Just "Name") True Nothing,+              VarDecl "project.version" VTText (Just (VText "0.1.0.0")) Nothing False Nothing+            ]+          output = formatDeclarations decls+          outputLines = T.lines output+      -- Both lines should have the same position for "="+      length (filter (T.isInfixOf "=") outputLines) `shouldBe` 2++    it "uses 2-space indentation" $ do+      let decls = [VarDecl "x" VTText Nothing Nothing True Nothing]+          output = formatDeclarations decls+      T.isInfixOf "  x" output `shouldBe` True++  describe "resolveVariables (six-layer precedence)" $ do+    it "resolves from local config" $ do+      let decls = [textVar "license" True Nothing Nothing]+          cli = Map.empty+          env = Map.empty+          local = Map.fromList [("license", "MIT")]+      case resolveVariables decls cli env "" "" local Map.empty Map.empty Map.empty Map.empty of+        Right resolved -> do+          (.value) (resolved Map.! "license") `shouldBe` VText "MIT"+          (.source) (resolved Map.! "license") `shouldBe` FromLocalConfig+        Left errs -> expectationFailure ("Expected Right, got: " <> show errs)++    it "resolves from namespace config" $ do+      let decls = [textVar "haskell.ghc" True Nothing Nothing]+          cli = Map.empty+          env = Map.empty+          nsCfg = Map.fromList [("haskell.ghc", "9.12.2")]+      case resolveVariables decls cli env "haskell" "" Map.empty nsCfg Map.empty Map.empty Map.empty of+        Right resolved -> do+          (.value) (resolved Map.! "haskell.ghc") `shouldBe` VText "9.12.2"+          (.source) (resolved Map.! "haskell.ghc") `shouldBe` FromNamespaceConfig "haskell"+        Left errs -> expectationFailure ("Expected Right, got: " <> show errs)++    it "resolves from global config" $ do+      let decls = [textVar "license" True Nothing Nothing]+          cli = Map.empty+          env = Map.empty+          global = Map.fromList [("license", "MIT")]+      case resolveVariables decls cli env "" "" Map.empty Map.empty Map.empty global Map.empty of+        Right resolved -> do+          (.value) (resolved Map.! "license") `shouldBe` VText "MIT"+          (.source) (resolved Map.! "license") `shouldBe` FromGlobalConfig+        Left errs -> expectationFailure ("Expected Right, got: " <> show errs)++    it "local config overrides global config" $ do+      let decls = [textVar "license" True Nothing Nothing]+          cli = Map.empty+          env = Map.empty+          local = Map.fromList [("license", "BSD3")]+          global = Map.fromList [("license", "MIT")]+      case resolveVariables decls cli env "" "" local Map.empty Map.empty global Map.empty of+        Right resolved -> do+          (.value) (resolved Map.! "license") `shouldBe` VText "BSD3"+          (.source) (resolved Map.! "license") `shouldBe` FromLocalConfig+        Left errs -> expectationFailure ("Expected Right, got: " <> show errs)++    it "namespace config overrides global config" $ do+      let decls = [textVar "license" True Nothing Nothing]+          cli = Map.empty+          env = Map.empty+          nsCfg = Map.fromList [("license", "Apache")]+          global = Map.fromList [("license", "MIT")]+      case resolveVariables decls cli env "haskell" "" Map.empty nsCfg Map.empty global Map.empty of+        Right resolved -> do+          (.value) (resolved Map.! "license") `shouldBe` VText "Apache"+          (.source) (resolved Map.! "license") `shouldBe` FromNamespaceConfig "haskell"+        Left errs -> expectationFailure ("Expected Right, got: " <> show errs)++    it "context config resolves when namespace and local don't have variable" $ do+      let decls = [textVar "user.email" True Nothing Nothing]+          cli = Map.empty+          env = Map.empty+          ctxCfg = Map.fromList [("user.email", "me@work.com")]+      case resolveVariables decls cli env "" "work" Map.empty Map.empty ctxCfg Map.empty Map.empty of+        Right resolved -> do+          (.value) (resolved Map.! "user.email") `shouldBe` VText "me@work.com"+          (.source) (resolved Map.! "user.email") `shouldBe` FromContextConfig "work"+        Left errs -> expectationFailure ("Expected Right, got: " <> show errs)++    it "context config is lower priority than namespace config" $ do+      let decls = [textVar "user.email" True Nothing Nothing]+          cli = Map.empty+          env = Map.empty+          nsCfg = Map.fromList [("user.email", "ns@example.com")]+          ctxCfg = Map.fromList [("user.email", "ctx@example.com")]+      case resolveVariables decls cli env "haskell" "work" Map.empty nsCfg ctxCfg Map.empty Map.empty of+        Right resolved -> do+          (.value) (resolved Map.! "user.email") `shouldBe` VText "ns@example.com"+          (.source) (resolved Map.! "user.email") `shouldBe` FromNamespaceConfig "haskell"+        Left errs -> expectationFailure ("Expected Right, got: " <> show errs)++    it "context config is higher priority than global config" $ do+      let decls = [textVar "user.email" True Nothing Nothing]+          cli = Map.empty+          env = Map.empty+          ctxCfg = Map.fromList [("user.email", "ctx@example.com")]+          global = Map.fromList [("user.email", "global@example.com")]+      case resolveVariables decls cli env "" "work" Map.empty Map.empty ctxCfg global Map.empty of+        Right resolved -> do+          (.value) (resolved Map.! "user.email") `shouldBe` VText "ctx@example.com"+          (.source) (resolved Map.! "user.email") `shouldBe` FromContextConfig "work"+        Left errs -> expectationFailure ("Expected Right, got: " <> show errs)++    it "local config overrides namespace config" $ do+      let decls = [textVar "license" True Nothing Nothing]+          cli = Map.empty+          env = Map.empty+          local = Map.fromList [("license", "GPL")]+          nsCfg = Map.fromList [("license", "Apache")]+      case resolveVariables decls cli env "haskell" "" local nsCfg Map.empty Map.empty Map.empty of+        Right resolved -> do+          (.value) (resolved Map.! "license") `shouldBe` VText "GPL"+          (.source) (resolved Map.! "license") `shouldBe` FromLocalConfig+        Left errs -> expectationFailure ("Expected Right, got: " <> show errs)++    it "env overrides local config" $ do+      let decls = [textVar "license" True Nothing Nothing]+          cli = Map.empty+          env = Map.fromList [("SEIHOU_VAR_LICENSE", "env-license")]+          local = Map.fromList [("license", "local-license")]+      case resolveVariables decls cli env "" "" local Map.empty Map.empty Map.empty Map.empty of+        Right resolved -> do+          (.value) (resolved Map.! "license") `shouldBe` VText "env-license"+          (.source) (resolved Map.! "license") `shouldBe` FromEnv "SEIHOU_VAR_LICENSE"+        Left errs -> expectationFailure ("Expected Right, got: " <> show errs)++    it "CLI overrides all config layers" $ do+      let decls = [textVar "license" True Nothing Nothing]+          cli = Map.fromList [("license", "cli-license")]+          env = Map.fromList [("SEIHOU_VAR_LICENSE", "env-license")]+          local = Map.fromList [("license", "local-license")]+          nsCfg = Map.fromList [("license", "ns-license")]+          global = Map.fromList [("license", "global-license")]+      case resolveVariables decls cli env "haskell" "" local nsCfg Map.empty global Map.empty of+        Right resolved -> do+          (.value) (resolved Map.! "license") `shouldBe` VText "cli-license"+          (.source) (resolved Map.! "license") `shouldBe` FromCLI+        Left errs -> expectationFailure ("Expected Right, got: " <> show errs)++    it "global config overrides module default" $ do+      let decls = [textVar "license" False (Just (VText "default-license")) Nothing]+          cli = Map.empty+          env = Map.empty+          global = Map.fromList [("license", "global-license")]+      case resolveVariables decls cli env "" "" Map.empty Map.empty Map.empty global Map.empty of+        Right resolved -> do+          (.value) (resolved Map.! "license") `shouldBe` VText "global-license"+          (.source) (resolved Map.! "license") `shouldBe` FromGlobalConfig+        Left errs -> expectationFailure ("Expected Right, got: " <> show errs)++    it "resolves mixed sources across multiple variables" $ do+      let decls =+            [ textVar "project.name" True Nothing Nothing,+              textVar "license" False (Just (VText "MIT")) Nothing,+              textVar "haskell.ghc" False (Just (VText "9.8.1")) Nothing+            ]+          cli = Map.fromList [("project.name", "cli-app")]+          env = Map.empty+          local = Map.fromList [("license", "BSD3")]+          nsCfg = Map.fromList [("haskell.ghc", "9.12.2")]+      case resolveVariables decls cli env "haskell" "" local nsCfg Map.empty Map.empty Map.empty of+        Right resolved -> do+          (.value) (resolved Map.! "project.name") `shouldBe` VText "cli-app"+          (.source) (resolved Map.! "project.name") `shouldBe` FromCLI+          (.value) (resolved Map.! "license") `shouldBe` VText "BSD3"+          (.source) (resolved Map.! "license") `shouldBe` FromLocalConfig+          (.value) (resolved Map.! "haskell.ghc") `shouldBe` VText "9.12.2"+          (.source) (resolved Map.! "haskell.ghc") `shouldBe` FromNamespaceConfig "haskell"+        Left errs -> expectationFailure ("Expected Right, got: " <> show errs)++    it "omits non-required variable with no value from any source" $ do+      let decls = [textVar "optional.var" False Nothing Nothing]+          cli = Map.empty+          env = Map.empty+      case resolveVariables decls cli env "" "" Map.empty Map.empty Map.empty Map.empty Map.empty of+        Right resolved -> Map.member "optional.var" resolved `shouldBe` False+        Left errs -> expectationFailure ("Expected Right, got: " <> show errs)++    it "still errors on missing required variable with no value" $ do+      let decls = [textVar "required.var" True Nothing Nothing]+          cli = Map.empty+          env = Map.empty+      case resolveVariables decls cli env "" "" Map.empty Map.empty Map.empty Map.empty Map.empty of+        Left errs -> errs `shouldBe` [MissingRequiredVar "required.var"]+        Right _ -> expectationFailure "Expected Left"++    it "resolves non-required variable when value is provided" $ do+      let decls = [textVar "optional.var" False Nothing Nothing]+          cli = Map.empty+          env = Map.empty+          global = Map.fromList [("optional.var", "from-global")]+      case resolveVariables decls cli env "" "" Map.empty Map.empty Map.empty global Map.empty of+        Right resolved -> do+          (.value) (resolved Map.! "optional.var") `shouldBe` VText "from-global"+          (.source) (resolved Map.! "optional.var") `shouldBe` FromGlobalConfig+        Left errs -> expectationFailure ("Expected Right, got: " <> show errs)++    it "resolves mix of required, optional-with-value, and optional-without-value" $ do+      let decls =+            [ textVar "project.name" True Nothing Nothing,+              textVar "optional.missing" False Nothing Nothing,+              textVar "optional.present" False Nothing Nothing+            ]+          cli = Map.fromList [("project.name", "my-app")]+          env = Map.empty+          global = Map.fromList [("optional.present", "found")]+      case resolveVariables decls cli env "" "" Map.empty Map.empty Map.empty global Map.empty of+        Right resolved -> do+          (.value) (resolved Map.! "project.name") `shouldBe` VText "my-app"+          Map.member "optional.missing" resolved `shouldBe` False+          (.value) (resolved Map.! "optional.present") `shouldBe` VText "found"+        Left errs -> expectationFailure ("Expected Right, got: " <> show errs)++    it "coerces config values through type system" $ do+      let decls = [boolVar "enable.tests" True Nothing]+          cli = Map.empty+          env = Map.empty+          local = Map.fromList [("enable.tests", "true")]+      case resolveVariables decls cli env "" "" local Map.empty Map.empty Map.empty Map.empty of+        Right resolved ->+          (.value) (resolved Map.! "enable.tests") `shouldBe` VBool True+        Left errs -> expectationFailure ("Expected Right, got: " <> show errs)++    it "resolves from parent-supplied vars" $ do+      let decls = [textVar "skill.name" True Nothing Nothing]+          cli = Map.empty+          env = Map.empty+          parentVars = Map.fromList [("skill.name", ("exec-plan", "parent-mod"))]+      case resolveVariables decls cli env "" "" Map.empty Map.empty Map.empty Map.empty parentVars of+        Right resolved -> do+          (.value) (resolved Map.! "skill.name") `shouldBe` VText "exec-plan"+          (.source) (resolved Map.! "skill.name") `shouldBe` FromParent "parent-mod"+        Left errs -> expectationFailure ("Expected Right, got: " <> show errs)++    it "parent-supplied var overrides module default" $ do+      let decls = [textVar "skill.name" False (Just (VText "default-val")) Nothing]+          cli = Map.empty+          env = Map.empty+          parentVars = Map.fromList [("skill.name", ("parent-val", "parent-mod"))]+      case resolveVariables decls cli env "" "" Map.empty Map.empty Map.empty Map.empty parentVars of+        Right resolved -> do+          (.value) (resolved Map.! "skill.name") `shouldBe` VText "parent-val"+          (.source) (resolved Map.! "skill.name") `shouldBe` FromParent "parent-mod"+        Left errs -> expectationFailure ("Expected Right, got: " <> show errs)++    it "global config overrides parent-supplied var" $ do+      let decls = [textVar "skill.name" True Nothing Nothing]+          cli = Map.empty+          env = Map.empty+          global = Map.fromList [("skill.name", "global-val")]+          parentVars = Map.fromList [("skill.name", ("parent-val", "parent-mod"))]+      case resolveVariables decls cli env "" "" Map.empty Map.empty Map.empty global parentVars of+        Right resolved -> do+          (.value) (resolved Map.! "skill.name") `shouldBe` VText "global-val"+          (.source) (resolved Map.! "skill.name") `shouldBe` FromGlobalConfig+        Left errs -> expectationFailure ("Expected Right, got: " <> show errs)++  describe "diagnoseResolution" $ do+    it "reports unused config keys" $ do+      let decl = textVar "project.name" True Nothing Nothing+          resolved = Map.fromList [("project.name", ResolvedVar (VText "app") FromCLI decl)]+          global = Map.fromList [("project.name", "app"), ("auther.name", "typo")]+          (unused, _) = diagnoseResolution resolved [decl] Map.empty Map.empty Map.empty global+      unused `shouldBe` [VarName "auther.name"]++    it "reports unresolved optional variables" $ do+      let decls =+            [ textVar "project.name" True Nothing Nothing,+              textVar "optional.var" False Nothing Nothing+            ]+          resolved = Map.fromList [("project.name", ResolvedVar (VText "app") FromCLI (head decls))]+          (_, unresolved) = diagnoseResolution resolved decls Map.empty Map.empty Map.empty Map.empty+      unresolved `shouldBe` [VarName "optional.var"]++    it "returns empty lists when everything matches" $ do+      let decl = textVar "license" True Nothing Nothing+          resolved = Map.fromList [("license", ResolvedVar (VText "MIT") FromGlobalConfig decl)]+          global = Map.fromList [("license", "MIT")]+          (unused, unresolved) = diagnoseResolution resolved [decl] Map.empty Map.empty Map.empty global+      unused `shouldBe` []+      unresolved `shouldBe` []++    it "detects unused keys across all config layers" $ do+      let decl = textVar "project.name" True Nothing Nothing+          resolved = Map.fromList [("project.name", ResolvedVar (VText "app") FromCLI decl)]+          local = Map.fromList [("local.extra", "x")]+          nsCfg = Map.fromList [("ns.extra", "y")]+          global = Map.fromList [("global.extra", "z")]+          (unused, _) = diagnoseResolution resolved [decl] local nsCfg Map.empty global+      unused `shouldBe` [VarName "global.extra", VarName "local.extra", VarName "ns.extra"]
+ test/Seihou/Core/VersionSpec.hs view
@@ -0,0 +1,70 @@+module Seihou.Core.VersionSpec (tests) where++import Seihou.Core.Version (Version (..), parseVersion, renderVersion)+import Test.Hspec+import Test.Tasty+import Test.Tasty.Hspec (testSpec)++tests :: IO TestTree+tests = testSpec "Seihou.Core.Version" spec++spec :: Spec+spec = do+  describe "parseVersion" $ do+    it "parses a three-segment version" $ do+      parseVersion "1.0.0" `shouldBe` Just (Version [1, 0, 0])++    it "parses a two-segment version" $ do+      parseVersion "1.2" `shouldBe` Just (Version [1, 2])++    it "parses a four-segment version" $ do+      parseVersion "1.2.3.4" `shouldBe` Just (Version [1, 2, 3, 4])++    it "parses a single-segment version" $ do+      parseVersion "5" `shouldBe` Just (Version [5])++    it "returns Nothing for empty string" $ do+      parseVersion "" `shouldBe` Nothing++    it "returns Nothing for non-numeric input" $ do+      parseVersion "abc" `shouldBe` Nothing++    it "returns Nothing for mixed input" $ do+      parseVersion "1.2.abc" `shouldBe` Nothing++    it "returns Nothing for negative segments" $ do+      parseVersion "1.-2.3" `shouldBe` Nothing++  describe "Eq instance" $ do+    it "considers equal versions with trailing zeros" $ do+      Version [1, 2, 0] == Version [1, 2] `shouldBe` True++    it "considers 1.0.0 equal to 1" $ do+      Version [1, 0, 0] == Version [1] `shouldBe` True++    it "distinguishes different versions" $ do+      Version [1, 2] == Version [1, 3] `shouldBe` False++  describe "Ord instance" $ do+    it "orders 1.2 < 1.10 (numeric, not lexicographic)" $ do+      Version [1, 2] < Version [1, 10] `shouldBe` True++    it "orders 2.0 > 1.99.99" $ do+      Version [2, 0] > Version [1, 99, 99] `shouldBe` True++    it "orders equal versions as EQ" $ do+      compare (Version [1, 2, 0]) (Version [1, 2]) `shouldBe` EQ++    it "orders 0.1 < 1.0" $ do+      Version [0, 1] < Version [1, 0] `shouldBe` True++  describe "renderVersion" $ do+    it "renders a three-segment version" $ do+      renderVersion (Version [1, 2, 3]) `shouldBe` "1.2.3"++    it "renders a single-segment version" $ do+      renderVersion (Version [5]) `shouldBe` "5"++    it "roundtrips with parseVersion" $ do+      let v = Version [1, 2, 3]+      parseVersion (renderVersion v) `shouldBe` Just v
+ test/Seihou/Dhall/ConfigSpec.hs view
@@ -0,0 +1,110 @@+module Seihou.Dhall.ConfigSpec (tests) where++import Data.Map.Strict qualified as Map+import Data.Text qualified as T+import Data.Text.IO qualified as TIO+import Seihou.Dhall.Config (escapeDhallText, evalConfigFile, evalConfigFileIfExists, serializeConfig)+import System.Directory (getCurrentDirectory)+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.Dhall.Config" spec++spec :: Spec+spec = do+  describe "evalConfigFile" $ do+    it "evaluates a simple Dhall config to Map Text Text" $ do+      withSystemTempDirectory "seihou-config-test" $ \tmpDir -> do+        let path = tmpDir </> "config.dhall"+        writeFile path "{ license = \"MIT\", `project.name` = \"my-app\" }"+        result <- evalConfigFile path+        Map.lookup "license" result `shouldBe` Just "MIT"+        Map.lookup "project.name" result `shouldBe` Just "my-app"++    it "evaluates an empty record" $ do+      withSystemTempDirectory "seihou-config-test" $ \tmpDir -> do+        let path = tmpDir </> "config.dhall"+        writeFile path "{=}"+        result <- evalConfigFile path+        Map.null result `shouldBe` True++  describe "evalConfigFileIfExists" $ do+    it "returns empty map for nonexistent file" $ do+      result <- evalConfigFileIfExists "/nonexistent/path/config.dhall"+      result `shouldBe` Right Map.empty++    it "returns Right map for valid config file" $ do+      withSystemTempDirectory "seihou-config-test" $ \tmpDir -> do+        let path = tmpDir </> "config.dhall"+        writeFile path "{ license = \"BSD3\" }"+        result <- evalConfigFileIfExists path+        case result of+          Left err -> expectationFailure ("Expected Right, got Left: " <> show err)+          Right m -> Map.lookup "license" m `shouldBe` Just "BSD3"++    it "returns Left for invalid Dhall" $ do+      withSystemTempDirectory "seihou-config-test" $ \tmpDir -> do+        let path = tmpDir </> "config.dhall"+        writeFile path "this is not valid dhall @@##"+        result <- evalConfigFileIfExists path+        case result of+          Left _ -> pure ()+          Right _ -> expectationFailure "Expected Left for invalid Dhall"++  describe "serializeConfig" $ do+    it "serializes an empty map to {=}" $ do+      serializeConfig Map.empty `shouldBe` "{=}\n"++    it "serializes a single entry" $ do+      let m = Map.fromList [("license", "MIT")]+          result = serializeConfig m+      result `shouldSatisfy` T.isInfixOf "`license`"+      result `shouldSatisfy` T.isInfixOf "\"MIT\""++    it "serializes multiple entries in sorted order" $ do+      let m = Map.fromList [("z-key", "last"), ("a-key", "first")]+          result = serializeConfig m+          aPos = T.findIndex (== 'a') result+          zPos = T.findIndex (== 'z') result+      -- a-key should appear before z-key (sorted)+      case (aPos, zPos) of+        (Just a, Just z) -> a `shouldSatisfy` (< z)+        _ -> expectationFailure "Expected both keys in output"++    it "round-trips through evalConfigFile" $ do+      withSystemTempDirectory "seihou-config-test" $ \tmpDir -> do+        let original = Map.fromList [("project.name", "my-app"), ("license", "MIT")]+            path = tmpDir </> "config.dhall"+        TIO.writeFile path (serializeConfig original)+        result <- evalConfigFile path+        result `shouldBe` original++    it "round-trips dotted keys" $ do+      withSystemTempDirectory "seihou-config-test" $ \tmpDir -> do+        let original = Map.fromList [("haskell.ghc", "9.12.2"), ("project.name", "test")]+            path = tmpDir </> "config.dhall"+        TIO.writeFile path (serializeConfig original)+        result <- evalConfigFile path+        result `shouldBe` original++    it "round-trips values with special characters" $ do+      withSystemTempDirectory "seihou-config-test" $ \tmpDir -> do+        let original = Map.fromList [("path", "C:\\Users\\me"), ("quote", "say \"hello\"")]+            path = tmpDir </> "config.dhall"+        TIO.writeFile path (serializeConfig original)+        result <- evalConfigFile path+        result `shouldBe` original++  describe "escapeDhallText" $ do+    it "passes through plain text unchanged" $ do+      escapeDhallText "hello world" `shouldBe` "hello world"++    it "escapes backslashes" $ do+      escapeDhallText "a\\b" `shouldBe` "a\\\\b"++    it "escapes double-quotes" $ do+      escapeDhallText "say \"hi\"" `shouldBe` "say \\\"hi\\\""
+ test/Seihou/Dhall/EvalSpec.hs view
@@ -0,0 +1,406 @@+module Seihou.Dhall.EvalSpec (tests) where++import Data.Map.Strict qualified as Map+import Data.Text qualified as T+import Seihou.Core.Types+import Seihou.Dhall.Eval (evalDhallExpr, evalModuleFromFile, evalRecipeFromFile)+import System.Directory (createDirectoryIfMissing)+import System.FilePath ((</>))+import System.IO.Temp (withSystemTempDirectory)+import Test.Hspec+import Test.Tasty+import Test.Tasty.Hspec (testSpec)++tests :: IO TestTree+tests = testSpec "Seihou.Dhall.Eval" spec++fixtureDir :: FilePath+fixtureDir = "test/fixtures"++-- | Build a minimal @module.dhall@ source containing a single variable with the+-- given name, declared type string, and @default@ Dhall expression (e.g.+-- @"Some \"true\""@ or @"None Text"@).+moduleWithVar :: String -> String -> String -> String+moduleWithVar varName varType defaultExpr =+  "{ name = \"var-test\"\n\+  \, version = None Text\n\+  \, description = None Text\n\+  \, vars =\n\+  \  [ { name = \""+    ++ varName+    ++ "\"\n\+       \    , type = \""+    ++ varType+    ++ "\"\n\+       \    , default = "+    ++ defaultExpr+    ++ "\n\+       \    , description = None Text\n\+       \    , required = False\n\+       \    , validation = None Text\n\+       \    }\n\+       \  ]\n\+       \, exports = [] : List { var : Text, alias : Optional Text }\n\+       \, prompts = [] : List { var : Text, text : Text, when : Optional Text, choices : Optional (List Text) }\n\+       \, steps = [] : List { strategy : Text, src : Text, dest : Text, when : Optional Text, patch : Optional Text }\n\+       \, commands = [] : List { run : Text, workDir : Optional Text, when : Optional Text }\n\+       \, dependencies = [] : List Text\n\+       \, removal = None { steps : List { action : Text, dest : Text, src : Optional Text }, commands : List { run : Text, workDir : Optional Text, when : Optional Text } }\n\+       \}"++spec :: Spec+spec = do+  describe "evalDhallExpr (spike)" $ do+    it "decodes a simple Dhall record with name and version" $ do+      result <- evalDhallExpr "{ name = \"my-project\", version = \"0.1.0\" }"+      Map.lookup "name" result `shouldBe` Just "my-project"+      Map.lookup "version" result `shouldBe` Just "0.1.0"++  describe "evalModuleFromFile" $ do+    it "decodes the haskell-base fixture module" $ do+      result <- evalModuleFromFile (fixtureDir </> "haskell-base" </> "module.dhall")+      case result of+        Left err -> expectationFailure ("Expected Right, got Left: " <> show err)+        Right m -> do+          m.name `shouldBe` ModuleName "haskell-base"+          m.description `shouldBe` Just "A Haskell project template"+          length (m.vars) `shouldBe` 3+          length (m.prompts) `shouldBe` 1+          length (m.steps) `shouldBe` 5+          length (m.exports) `shouldBe` 1+          m.dependencies `shouldBe` []++    it "decodes variable declarations correctly" $ do+      result <- evalModuleFromFile (fixtureDir </> "haskell-base" </> "module.dhall")+      case result of+        Left err -> expectationFailure ("Expected Right, got Left: " <> show err)+        Right m -> do+          let (projectName : projectVersion : _) = m.vars+          projectName.name `shouldBe` VarName "project.name"+          projectName.type_ `shouldBe` VTText+          projectName.default_ `shouldBe` Nothing+          projectName.required `shouldBe` True+          projectName.validation `shouldBe` Just (ValPattern "[a-z][a-z0-9-]*")++          projectVersion.name `shouldBe` VarName "project.version"+          projectVersion.default_ `shouldBe` Just (VText "0.1.0.0")+          projectVersion.required `shouldBe` False++    it "decodes steps with correct strategy" $ do+      result <- evalModuleFromFile (fixtureDir </> "haskell-base" </> "module.dhall")+      case result of+        Left err -> expectationFailure ("Expected Right, got Left: " <> show err)+        Right m -> do+          let (readme : libStep : licenseStep : _) = m.steps+          readme.strategy `shouldBe` Template+          readme.src `shouldBe` "README.md.tpl"+          readme.dest `shouldBe` "README.md"+          readme.condition `shouldBe` Nothing+          readme.patch `shouldBe` Nothing++          libStep.strategy `shouldBe` Template+          libStep.src `shouldBe` "src/Lib.hs.tpl"+          libStep.dest `shouldBe` "src/Lib.hs"+          libStep.patch `shouldBe` Nothing++          licenseStep.strategy `shouldBe` Copy+          licenseStep.src `shouldBe` "LICENSE"+          licenseStep.dest `shouldBe` "LICENSE"+          licenseStep.condition `shouldBe` Just (ExprIsSet "license")+          licenseStep.patch `shouldBe` Nothing++    it "decodes exports correctly" $ do+      result <- evalModuleFromFile (fixtureDir </> "haskell-base" </> "module.dhall")+      case result of+        Left err -> expectationFailure ("Expected Right, got Left: " <> show err)+        Right m -> do+          let (export1 : _) = m.exports+          export1.var `shouldBe` VarName "project.name"+          export1.alias `shouldBe` Nothing++    it "returns DhallEvalError for nonexistent file" $ do+      result <- evalModuleFromFile "/nonexistent/path/module.dhall"+      case result of+        Left (DhallEvalError _ _) -> pure ()+        Left other -> expectationFailure ("Expected DhallEvalError, got: " <> show other)+        Right _ -> expectationFailure "Expected Left, got Right"++    it "returns Left for unknown var type (not a crash)" $ do+      result <- evalModuleFromFile (fixtureDir </> "bad-vartype" </> "module.dhall")+      case result of+        Left (DhallEvalError _ msg) ->+          T.isInfixOf "strng" msg `shouldBe` True+        Left other -> expectationFailure ("Expected DhallEvalError, got: " <> show other)+        Right _ -> expectationFailure "Expected Left for bad var type"++    it "returns Left for unknown strategy (not a crash)" $ do+      result <- evalModuleFromFile (fixtureDir </> "bad-strategy" </> "module.dhall")+      case result of+        Left (DhallEvalError _ msg) ->+          T.isInfixOf "coppy" msg `shouldBe` True+        Left other -> expectationFailure ("Expected DhallEvalError, got: " <> show other)+        Right _ -> expectationFailure "Expected Left for bad strategy"++    it "decodes prompts correctly" $ do+      result <- evalModuleFromFile (fixtureDir </> "haskell-base" </> "module.dhall")+      case result of+        Left err -> expectationFailure ("Expected Right, got Left: " <> show err)+        Right m -> do+          let (prompt1 : _) = m.prompts+          prompt1.var `shouldBe` VarName "project.name"+          prompt1.text `shouldBe` "What is the project name?"+          prompt1.condition `shouldBe` Nothing+          prompt1.choices `shouldBe` Nothing++    it "decodes step with patch = Some \"append-file\"" $ do+      withSystemTempDirectory "seihou-eval-test" $ \tmpDir -> do+        createDirectoryIfMissing True (tmpDir </> "files")+        writeFile (tmpDir </> "files" </> "section.tpl") "section content"+        let dhall =+              "{ name = \"patch-test\"\n\+              \, version = None Text\n\+              \, description = None Text\n\+              \, vars = [] : List { name : Text, type : Text, default : Optional Text, description : Optional Text, required : Bool, validation : Optional Text }\n\+              \, exports = [] : List { var : Text, alias : Optional Text }\n\+              \, prompts = [] : List { var : Text, text : Text, when : Optional Text, choices : Optional (List Text) }\n\+              \, steps =\n\+              \  [ { strategy = \"template\"\n\+              \    , src = \"section.tpl\"\n\+              \    , dest = \"README.md\"\n\+              \    , when = None Text\n\+              \    , patch = Some \"append-file\"\n\+              \    }\n\+              \  , { strategy = \"template\"\n\+              \    , src = \"section.tpl\"\n\+              \    , dest = \"README.md\"\n\+              \    , when = None Text\n\+              \    , patch = Some \"prepend-file\"\n\+              \    }\n\+              \  , { strategy = \"template\"\n\+              \    , src = \"section.tpl\"\n\+              \    , dest = \"README.md\"\n\+              \    , when = None Text\n\+              \    , patch = Some \"append-section\"\n\+              \    }\n\+              \  ]\n\+              \, commands = [] : List { run : Text, workDir : Optional Text, when : Optional Text }\n\+              \, dependencies = [] : List Text\n\+              \, removal = None { steps : List { action : Text, dest : Text, src : Optional Text }, commands : List { run : Text, workDir : Optional Text, when : Optional Text } }\n\+              \}"+        writeFile (tmpDir </> "module.dhall") dhall+        result <- evalModuleFromFile (tmpDir </> "module.dhall")+        case result of+          Left err -> expectationFailure ("Expected Right, got Left: " <> show err)+          Right m -> do+            let (s1 : s2 : s3 : _) = m.steps+            s1.patch `shouldBe` Just AppendFile+            s2.patch `shouldBe` Just PrependFile+            s3.patch `shouldBe` Just AppendSection++    it "returns Left for unknown patch operation (not a crash)" $ do+      withSystemTempDirectory "seihou-eval-test" $ \tmpDir -> do+        createDirectoryIfMissing True (tmpDir </> "files")+        writeFile (tmpDir </> "files" </> "section.tpl") "content"+        let dhall =+              "{ name = \"bad-patch\"\n\+              \, version = None Text\n\+              \, description = None Text\n\+              \, vars = [] : List { name : Text, type : Text, default : Optional Text, description : Optional Text, required : Bool, validation : Optional Text }\n\+              \, exports = [] : List { var : Text, alias : Optional Text }\n\+              \, prompts = [] : List { var : Text, text : Text, when : Optional Text, choices : Optional (List Text) }\n\+              \, steps =\n\+              \  [ { strategy = \"template\"\n\+              \    , src = \"section.tpl\"\n\+              \    , dest = \"README.md\"\n\+              \    , when = None Text\n\+              \    , patch = Some \"invalid-op\"\n\+              \    }\n\+              \  ]\n\+              \, commands = [] : List { run : Text, workDir : Optional Text, when : Optional Text }\n\+              \, dependencies = [] : List Text\n\+              \, removal = None { steps : List { action : Text, dest : Text, src : Optional Text }, commands : List { run : Text, workDir : Optional Text, when : Optional Text } }\n\+              \}"+        writeFile (tmpDir </> "module.dhall") dhall+        result <- evalModuleFromFile (tmpDir </> "module.dhall")+        case result of+          Left (DhallEvalError _ msg) ->+            T.isInfixOf "invalid-op" msg `shouldBe` True+          Left other -> expectationFailure ("Expected DhallEvalError, got: " <> show other)+          Right _ -> expectationFailure "Expected Left for bad patch operation"++    it "coerces a bool default to VBool at decode time" $ do+      withSystemTempDirectory "seihou-eval-test" $ \tmpDir -> do+        writeFile (tmpDir </> "module.dhall") (moduleWithVar "feature.on" "bool" "Some \"true\"")+        result <- evalModuleFromFile (tmpDir </> "module.dhall")+        case result of+          Left err -> expectationFailure ("Expected Right, got Left: " <> show err)+          Right m -> do+            let v = head m.vars+            v.type_ `shouldBe` VTBool+            v.default_ `shouldBe` Just (VBool True)++    it "coerces an int default to VInt at decode time" $ do+      withSystemTempDirectory "seihou-eval-test" $ \tmpDir -> do+        writeFile (tmpDir </> "module.dhall") (moduleWithVar "retries" "int" "Some \"3\"")+        result <- evalModuleFromFile (tmpDir </> "module.dhall")+        case result of+          Left err -> expectationFailure ("Expected Right, got Left: " <> show err)+          Right m -> do+            let v = head m.vars+            v.type_ `shouldBe` VTInt+            v.default_ `shouldBe` Just (VInt 3)++    it "fails module load on a malformed bool default" $ do+      withSystemTempDirectory "seihou-eval-test" $ \tmpDir -> do+        writeFile (tmpDir </> "module.dhall") (moduleWithVar "feature.on" "bool" "Some \"treu\"")+        result <- evalModuleFromFile (tmpDir </> "module.dhall")+        case result of+          Left (DhallEvalError _ msg) -> do+            T.isInfixOf "feature.on" msg `shouldBe` True+            T.isInfixOf "treu" msg `shouldBe` True+          Left other -> expectationFailure ("Expected DhallEvalError, got: " <> show other)+          Right _ -> expectationFailure "Expected Left for malformed bool default"++  describe "dependencyDecoder" $ do+    let emptyModuleWithDeps depsStr =+          "{ name = \"test-mod\"\n\+          \, version = None Text\n\+          \, description = None Text\n\+          \, vars = [] : List { name : Text, type : Text, default : Optional Text, description : Optional Text, required : Bool, validation : Optional Text }\n\+          \, exports = [] : List { var : Text, alias : Optional Text }\n\+          \, prompts = [] : List { var : Text, text : Text, when : Optional Text, choices : Optional (List Text) }\n\+          \, steps = [] : List { strategy : Text, src : Text, dest : Text, when : Optional Text, patch : Optional Text }\n\+          \, commands = [] : List { run : Text, workDir : Optional Text, when : Optional Text }\n\+          \, dependencies = "+            ++ depsStr+            ++ "\n\+               \, removal = None { steps : List { action : Text, dest : Text, src : Optional Text }, commands : List { run : Text, workDir : Optional Text, when : Optional Text } }\n\+               \}"++    it "decodes a bare string dependency" $ do+      withSystemTempDirectory "seihou-eval-test" $ \tmpDir -> do+        writeFile (tmpDir </> "module.dhall") (emptyModuleWithDeps "[\"base\"]")+        result <- evalModuleFromFile (tmpDir </> "module.dhall")+        case result of+          Left err -> expectationFailure ("Expected Right, got Left: " <> show err)+          Right m -> do+            length m.dependencies `shouldBe` 1+            let dep = head m.dependencies+            dep.depModule `shouldBe` ModuleName "base"+            Map.null dep.depVars `shouldBe` True++    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\" }] }]")+        result <- evalModuleFromFile (tmpDir </> "module.dhall")+        case result of+          Left err -> expectationFailure ("Expected Right, got Left: " <> show err)+          Right m -> do+            length m.dependencies `shouldBe` 1+            let dep = head m.dependencies+            dep.depModule `shouldBe` ModuleName "base"+            Map.lookup (VarName "x") dep.depVars `shouldBe` Just "y"++    it "decodes a parameterized dependency with empty vars" $ do+      withSystemTempDirectory "seihou-eval-test" $ \tmpDir -> do+        writeFile (tmpDir </> "module.dhall") (emptyModuleWithDeps "[{ module = \"base\", vars = [] : List { name : Text, value : Text } }]")+        result <- evalModuleFromFile (tmpDir </> "module.dhall")+        case result of+          Left err -> expectationFailure ("Expected Right, got Left: " <> show err)+          Right m -> do+            length m.dependencies `shouldBe` 1+            let dep = head m.dependencies+            dep.depModule `shouldBe` ModuleName "base"+            Map.null dep.depVars `shouldBe` True++    it "decodes a module.dhall with parameterized dependencies" $ do+      withSystemTempDirectory "seihou-eval-test" $ \tmpDir -> do+        writeFile (tmpDir </> "module.dhall") (emptyModuleWithDeps "[{ module = \"child-mod\", vars = [{ name = \"skill.name\", value = \"exec-plan\" }] }]")+        result <- evalModuleFromFile (tmpDir </> "module.dhall")+        case result of+          Left err -> expectationFailure ("Expected Right, got Left: " <> show err)+          Right m -> do+            length m.dependencies `shouldBe` 1+            let dep = head m.dependencies+            dep.depModule `shouldBe` ModuleName "child-mod"+            Map.lookup (VarName "skill.name") dep.depVars `shouldBe` Just "exec-plan"++  describe "evalRecipeFromFile" $ do+    it "decodes the haskell-with-nix-recipe fixture" $ do+      result <- evalRecipeFromFile (fixtureDir </> "haskell-with-nix-recipe" </> "recipe.dhall")+      case result of+        Left err -> expectationFailure ("Expected Right, got Left: " <> show err)+        Right r -> do+          r.name `shouldBe` RecipeName "haskell-with-nix"+          r.version `shouldBe` Just "1.0.0"+          r.description `shouldBe` Just "Haskell project with Nix integration"+          length r.modules `shouldBe` 2+          let (m1 : m2 : _) = r.modules+          m1.depModule `shouldBe` ModuleName "haskell-base"+          Map.null m1.depVars `shouldBe` True+          m2.depModule `shouldBe` ModuleName "nix-flake"+          Map.null m2.depVars `shouldBe` True+          r.vars `shouldBe` []+          r.prompts `shouldBe` []++    it "decodes the haskell-pinned-recipe fixture with variable bindings" $ do+      result <- evalRecipeFromFile (fixtureDir </> "haskell-pinned-recipe" </> "recipe.dhall")+      case result of+        Left err -> expectationFailure ("Expected Right, got Left: " <> show err)+        Right r -> do+          r.name `shouldBe` RecipeName "haskell-pinned"+          length r.modules `shouldBe` 2+          let (m1 : m2 : _) = r.modules+          m1.depModule `shouldBe` ModuleName "haskell-base"+          Map.null m1.depVars `shouldBe` True+          m2.depModule `shouldBe` ModuleName "nix-flake"+          Map.lookup (VarName "nix.system") m2.depVars `shouldBe` Just "aarch64-darwin"++    it "returns DhallEvalError for nonexistent recipe file" $ do+      result <- evalRecipeFromFile "/nonexistent/path/recipe.dhall"+      case result of+        Left (DhallEvalError _ _) -> pure ()+        Left other -> expectationFailure ("Expected DhallEvalError, got: " <> show other)+        Right _ -> expectationFailure "Expected Left, got Right"++    it "decodes a recipe with recipe-level vars and prompts" $ do+      withSystemTempDirectory "seihou-eval-test" $ \tmpDir -> do+        let dhall =+              "{ name = \"prompted-recipe\"\n\+              \, version = Some \"1.0.0\"\n\+              \, description = Some \"Recipe with prompts\"\n\+              \, modules =\n\+              \  [ { module = \"base\", vars = [] : List { name : Text, value : Text } }\n\+              \  ]\n\+              \, vars =\n\+              \  [ { name = \"project.name\"\n\+              \    , type = \"text\"\n\+              \    , default = None Text\n\+              \    , description = Some \"Project name\"\n\+              \    , required = True\n\+              \    , validation = None Text\n\+              \    }\n\+              \  ]\n\+              \, prompts =\n\+              \  [ { var = \"project.name\"\n\+              \    , text = \"What is the project name?\"\n\+              \    , when = None Text\n\+              \    , choices = None (List Text)\n\+              \    }\n\+              \  ]\n\+              \}"+        writeFile (tmpDir </> "recipe.dhall") dhall+        result <- evalRecipeFromFile (tmpDir </> "recipe.dhall")+        case result of+          Left err -> expectationFailure ("Expected Right, got Left: " <> show err)+          Right r -> do+            r.name `shouldBe` RecipeName "prompted-recipe"+            length r.vars `shouldBe` 1+            let v = head r.vars+            v.name `shouldBe` VarName "project.name"+            v.type_ `shouldBe` VTText+            v.required `shouldBe` True+            length r.prompts `shouldBe` 1+            let p = head r.prompts+            p.var `shouldBe` VarName "project.name"+            p.text `shouldBe` "What is the project name?"
+ test/Seihou/Dhall/MigrationDecoderSpec.hs view
@@ -0,0 +1,248 @@+module Seihou.Dhall.MigrationDecoderSpec (tests) where++import Data.Text (Text)+import Data.Text qualified as T+import Data.Text.IO qualified as TIO+import Seihou.Core.Migration (Migration (..), MigrationOp (..))+import Seihou.Core.Types (Module (..), ModuleLoadError)+import Seihou.Dhall.Eval (evalModuleFromFile)+import System.Directory (createDirectoryIfMissing)+import System.FilePath ((</>))+import System.IO.Temp (withSystemTempDirectory)+import Test.Hspec+import Test.Tasty+import Test.Tasty.Hspec (testSpec)++tests :: IO TestTree+tests = testSpec "Seihou.Dhall.MigrationDecoder" spec++spec :: Spec+spec = do+  describe "moduleDecoder migrations field" $ do+    it "decodes a module with no migrations field as []" $+      withModuleDhall noMigrationsField $ \result ->+        case result of+          Right m -> m.migrations `shouldBe` []+          Left err -> expectationFailure ("Expected Right, got: " <> show err)++    it "decodes a module with an empty migrations list" $+      withModuleDhall emptyMigrations $ \result ->+        case result of+          Right m -> m.migrations `shouldBe` []+          Left err -> expectationFailure ("Expected Right, got: " <> show err)++    it "decodes a single MoveFile migration" $+      withModuleDhall (oneMigration moveFileOp) $ \result ->+        case result of+          Right m -> case m.migrations of+            [Migration {from = "1.0.0", to = "2.0.0", ops = [op]}] ->+              op `shouldBe` MoveFile {src = "old/Path.hs", dest = "new/Path.hs"}+            other -> expectationFailure ("Unexpected migrations: " <> show other)+          Left err -> expectationFailure ("Expected Right, got: " <> show err)++    it "decodes a MoveDir migration" $+      withModuleDhall (oneMigration moveDirOp) $ \result ->+        case result of+          Right m -> case m.migrations of+            [Migration {ops = [op]}] ->+              op `shouldBe` MoveDir {src = "app", dest = "src"}+            other -> expectationFailure ("Unexpected migrations: " <> show other)+          Left err -> expectationFailure ("Expected Right, got: " <> show err)++    it "decodes a DeleteFile migration" $+      withModuleDhall (oneMigration deleteFileOp) $ \result ->+        case result of+          Right m -> case m.migrations of+            [Migration {ops = [op]}] ->+              op `shouldBe` DeleteFile {path = "Setup.hs"}+            other -> expectationFailure ("Unexpected migrations: " <> show other)+          Left err -> expectationFailure ("Expected Right, got: " <> show err)++    it "decodes a DeleteDir migration" $+      withModuleDhall (oneMigration deleteDirOp) $ \result ->+        case result of+          Right m -> case m.migrations of+            [Migration {ops = [op]}] ->+              op `shouldBe` DeleteDir {path = "obsolete"}+            other -> expectationFailure ("Unexpected migrations: " <> show other)+          Left err -> expectationFailure ("Expected Right, got: " <> show err)++    it "decodes a RunCommand migration without workDir" $+      withModuleDhall (oneMigration runCommandNoWorkDir) $ \result ->+        case result of+          Right m -> case m.migrations of+            [Migration {ops = [op]}] ->+              op `shouldBe` RunCommand {run = "echo hi", workDir = Nothing}+            other -> expectationFailure ("Unexpected migrations: " <> show other)+          Left err -> expectationFailure ("Expected Right, got: " <> show err)++    it "decodes a RunCommand migration with workDir" $+      withModuleDhall (oneMigration runCommandWithWorkDir) $ \result ->+        case result of+          Right m -> case m.migrations of+            [Migration {ops = [op]}] ->+              op `shouldBe` RunCommand {run = "make clean", workDir = Just "build"}+            other -> expectationFailure ("Unexpected migrations: " <> show other)+          Left err -> expectationFailure ("Expected Right, got: " <> show err)++    it "decodes multiple ops in a single migration in declaration order" $+      withModuleDhall multiOpMigration $ \result ->+        case result of+          Right m -> case m.migrations of+            [Migration {ops}] ->+              ops+                `shouldBe` [ MoveDir {src = "app", dest = "src"},+                             DeleteFile {path = "Setup.hs"},+                             RunCommand {run = "echo hi", workDir = Nothing}+                           ]+            other -> expectationFailure ("Unexpected migrations: " <> show other)+          Left err -> expectationFailure ("Expected Right, got: " <> show err)++    it "decodes multiple migrations in declaration order" $+      withModuleDhall twoChainedMigrations $ \result ->+        case result of+          Right m -> case m.migrations of+            [m1, m2] -> do+              m1.from `shouldBe` "1.0.0"+              m1.to `shouldBe` "2.0.0"+              m2.from `shouldBe` "2.0.0"+              m2.to `shouldBe` "3.0.0"+            other -> expectationFailure ("Unexpected migrations: " <> show other)+          Left err -> expectationFailure ("Expected Right, got: " <> show err)++-- ----------------------------------------------------------------------------+-- Helper: write a tmp module.dhall and run the file evaluator on it.+-- ----------------------------------------------------------------------------++withModuleDhall ::+  Text ->+  (Either ModuleLoadError Module -> IO ()) ->+  IO ()+withModuleDhall body action =+  withSystemTempDirectory "seihou-migration-decoder" $ \dir -> do+    createDirectoryIfMissing True (dir </> "files")+    let path = dir </> "module.dhall"+    TIO.writeFile path body+    result <- evalModuleFromFile path+    action result++-- ----------------------------------------------------------------------------+-- Module fixtures expressed inline as Dhall text.+-- ----------------------------------------------------------------------------++-- Bare-record skeleton for a module without the migrations field. The+-- decoder's withDefaults injects an empty list when the field is absent.+noMigrationsField :: Text+noMigrationsField =+  T.unlines+    [ "{ name = \"sample\"",+      ", version = Some \"1.0.0\"",+      ", description = None Text",+      ", vars = [] : List { name : Text, type : Text, default : Optional Text, description : Optional Text, required : Bool, validation : Optional Text }",+      ", exports = [] : List { var : Text, alias : Optional Text }",+      ", prompts = [] : List { var : Text, text : Text, when : Optional Text, choices : Optional (List Text) }",+      ", steps = [] : List { strategy : Text, src : Text, dest : Text, when : Optional Text, patch : Optional Text }",+      ", commands = [] : List { run : Text, workDir : Optional Text, when : Optional Text }",+      ", dependencies = [] : List { module : Text, vars : List { name : Text, value : Text } }",+      ", removal = None { steps : List { action : Text, dest : Text, src : Optional Text }, commands : List { run : Text, workDir : Optional Text, when : Optional Text } }",+      "}"+    ]++migrationFieldType :: Text+migrationFieldType =+  "List { from : Text, to : Text, ops : List < MoveFile : { src : Text, dest : Text } | MoveDir : { src : Text, dest : Text } | DeleteFile : { path : Text } | DeleteDir : { path : Text } | RunCommand : { run : Text, workDir : Optional Text } > }"++emptyMigrations :: Text+emptyMigrations = withMigrations ("[] : " <> migrationFieldType)++oneMigration :: Text -> Text+oneMigration opLit =+  withMigrations $+    T.intercalate+      "\n"+      [ "[ { from = \"1.0.0\"",+        "  , to = \"2.0.0\"",+        "  , ops = [ " <> opLit <> " ]",+        "  }",+        "]"+      ]++multiOpMigration :: Text+multiOpMigration =+  withMigrations $+    T.intercalate+      "\n"+      [ "[ { from = \"1.0.0\"",+        "  , to = \"2.0.0\"",+        "  , ops =",+        "      [ " <> moveDirOp,+        "      , " <> deleteFileOp,+        "      , " <> runCommandNoWorkDir,+        "      ]",+        "  }",+        "]"+      ]++twoChainedMigrations :: Text+twoChainedMigrations =+  withMigrations $+    T.intercalate+      "\n"+      [ "[ { from = \"1.0.0\"",+        "  , to = \"2.0.0\"",+        "  , ops = [ " <> moveDirOp <> " ]",+        "  }",+        ", { from = \"2.0.0\"",+        "  , to = \"3.0.0\"",+        "  , ops = [ " <> deleteFileOp <> " ]",+        "  }",+        "]"+      ]++-- | Splice an explicit migrations literal into the bare-record skeleton.+withMigrations :: Text -> Text+withMigrations migrationsLit =+  T.unlines+    [ "{ name = \"sample\"",+      ", version = Some \"1.0.0\"",+      ", description = None Text",+      ", vars = [] : List { name : Text, type : Text, default : Optional Text, description : Optional Text, required : Bool, validation : Optional Text }",+      ", exports = [] : List { var : Text, alias : Optional Text }",+      ", prompts = [] : List { var : Text, text : Text, when : Optional Text, choices : Optional (List Text) }",+      ", steps = [] : List { strategy : Text, src : Text, dest : Text, when : Optional Text, patch : Optional Text }",+      ", commands = [] : List { run : Text, workDir : Optional Text, when : Optional Text }",+      ", dependencies = [] : List { module : Text, vars : List { name : Text, value : Text } }",+      ", removal = None { steps : List { action : Text, dest : Text, src : Optional Text }, commands : List { run : Text, workDir : Optional Text, when : Optional Text } }",+      ", migrations = " <> migrationsLit,+      "}"+    ]++-- Dhall union literals for each MigrationOp variant. Each is a fully+-- qualified, type-annotated expression so it can be embedded in a list+-- without an enclosing type annotation on the list elements.++migrationOpType :: Text+migrationOpType =+  "< MoveFile : { src : Text, dest : Text } | MoveDir : { src : Text, dest : Text } | DeleteFile : { path : Text } | DeleteDir : { path : Text } | RunCommand : { run : Text, workDir : Optional Text } >"++opLit :: Text -> Text -> Text+opLit ctor body =+  "(" <> migrationOpType <> ").\n      " <> ctor <> " " <> body++moveFileOp :: Text+moveFileOp = opLit "MoveFile" "{ src = \"old/Path.hs\", dest = \"new/Path.hs\" }"++moveDirOp :: Text+moveDirOp = opLit "MoveDir" "{ src = \"app\", dest = \"src\" }"++deleteFileOp :: Text+deleteFileOp = opLit "DeleteFile" "{ path = \"Setup.hs\" }"++deleteDirOp :: Text+deleteDirOp = opLit "DeleteDir" "{ path = \"obsolete\" }"++runCommandNoWorkDir :: Text+runCommandNoWorkDir = opLit "RunCommand" "{ run = \"echo hi\", workDir = None Text }"++runCommandWithWorkDir :: Text+runCommandWithWorkDir = opLit "RunCommand" "{ run = \"make clean\", workDir = Some \"build\" }"
+ test/Seihou/Effect/ConfigReaderSpec.hs view
@@ -0,0 +1,125 @@+module Seihou.Effect.ConfigReaderSpec (tests) where++import Data.Map.Strict qualified as Map+import Data.Text qualified as T+import Effectful+import Seihou.Core.Types (ConfigError (..))+import Seihou.Dhall.Config (evalConfigFileIfExists)+import Seihou.Effect.ConfigReader (readContextConfig, readGlobalConfig, readLocalConfig, readNamespaceConfig)+import Seihou.Effect.ConfigReaderInterp (runConfigReader)+import Seihou.Effect.ConfigReaderPure (runConfigReaderPure)+import System.IO.Temp (withSystemTempDirectory)+import Test.Hspec+import Test.Tasty+import Test.Tasty.Hspec (testSpec)++tests :: IO TestTree+tests = testSpec "Seihou.Effect.ConfigReader" spec++spec :: Spec+spec = do+  describe "pure interpreter" $ do+    it "ReadGlobalConfig returns the scripted global map" $ do+      let globalCfg = Map.fromList [("license", "MIT"), ("author", "Test")]+          result = runPureEff $ runConfigReaderPure Map.empty Map.empty Map.empty globalCfg readGlobalConfig+      result `shouldBe` Right globalCfg++    it "ReadLocalConfig returns the scripted local map" $ do+      let localCfg = Map.fromList [("project.name", "local-app")]+          result = runPureEff $ runConfigReaderPure localCfg Map.empty Map.empty Map.empty readLocalConfig+      result `shouldBe` Right localCfg++    it "ReadNamespaceConfig returns the scripted namespace map" $ do+      let nsCfgs = Map.fromList [("haskell", Map.fromList [("haskell.ghc", "9.12.2")])]+          result = runPureEff $ runConfigReaderPure Map.empty nsCfgs Map.empty Map.empty (readNamespaceConfig "haskell")+      result `shouldBe` Right (Map.fromList [("haskell.ghc", "9.12.2")])++    it "ReadNamespaceConfig returns empty for unknown namespace" $ do+      let nsCfgs = Map.fromList [("haskell", Map.fromList [("haskell.ghc", "9.12.2")])]+          result = runPureEff $ runConfigReaderPure Map.empty nsCfgs Map.empty Map.empty (readNamespaceConfig "nix")+      result `shouldBe` Right Map.empty++    it "ReadContextConfig returns the scripted context map" $ do+      let ctxCfgs = Map.fromList [("work", Map.fromList [("user.email", "work@example.com")])]+          result = runPureEff $ runConfigReaderPure Map.empty Map.empty ctxCfgs Map.empty (readContextConfig "work")+      result `shouldBe` Right (Map.fromList [("user.email", "work@example.com")])++    it "ReadContextConfig returns empty for unknown context" $ do+      let ctxCfgs = Map.fromList [("work", Map.fromList [("user.email", "work@example.com")])]+          result = runPureEff $ runConfigReaderPure Map.empty Map.empty ctxCfgs Map.empty (readContextConfig "personal")+      result `shouldBe` Right Map.empty++    it "returns independent values from each config layer" $ do+      let localCfg = Map.fromList [("project.name", "local-app")]+          nsCfgs = Map.fromList [("haskell", Map.fromList [("haskell.ghc", "9.12.2")])]+          ctxCfgs = Map.fromList [("work", Map.fromList [("user.email", "work@example.com")])]+          globalCfg = Map.fromList [("license", "MIT")]+          (local, ns, ctx, global) = runPureEff $ runConfigReaderPure localCfg nsCfgs ctxCfgs globalCfg $ do+            l <- readLocalConfig+            n <- readNamespaceConfig "haskell"+            c <- readContextConfig "work"+            g <- readGlobalConfig+            pure (l, n, c, g)+      local `shouldBe` Right localCfg+      ns `shouldBe` Right (Map.fromList [("haskell.ghc", "9.12.2")])+      ctx `shouldBe` Right (Map.fromList [("user.email", "work@example.com")])+      global `shouldBe` Right globalCfg++  describe "namespace validation (IO interpreter)" $ do+    it "rejects namespace containing '..'" $ do+      result <- runEff $ runConfigReader $ readNamespaceConfig "../etc"+      case result of+        Left (InvalidNamespace ns _) -> ns `shouldBe` "../etc"+        Left other -> expectationFailure ("Expected InvalidNamespace, got: " <> show other)+        Right _ -> expectationFailure "Expected Left for path traversal namespace"++    it "rejects namespace containing '/'" $ do+      result <- runEff $ runConfigReader $ readNamespaceConfig "foo/bar"+      case result of+        Left (InvalidNamespace ns _) -> ns `shouldBe` "foo/bar"+        Left other -> expectationFailure ("Expected InvalidNamespace, got: " <> show other)+        Right _ -> expectationFailure "Expected Left for namespace with slash"++    it "accepts a normal namespace" $ do+      result <- runEff $ runConfigReader $ readNamespaceConfig "haskell"+      case result of+        Left (InvalidNamespace _ _) -> expectationFailure "Did not expect InvalidNamespace for 'haskell'"+        _ -> pure () -- Right or ConfigParseError (missing file) are both OK+    it "returns Right empty for empty namespace" $ do+      result <- runEff $ runConfigReader $ readNamespaceConfig ""+      result `shouldBe` Right Map.empty++  describe "context validation (IO interpreter)" $ do+    it "rejects context containing '..'" $ do+      result <- runEff $ runConfigReader $ readContextConfig "../etc"+      case result of+        Left (InvalidNamespace ctx _) -> ctx `shouldBe` "../etc"+        Left other -> expectationFailure ("Expected InvalidNamespace, got: " <> show other)+        Right _ -> expectationFailure "Expected Left for path traversal context"++    it "rejects context containing '/'" $ do+      result <- runEff $ runConfigReader $ readContextConfig "foo/bar"+      case result of+        Left (InvalidNamespace ctx _) -> ctx `shouldBe` "foo/bar"+        Left other -> expectationFailure ("Expected InvalidNamespace, got: " <> show other)+        Right _ -> expectationFailure "Expected Left for context with slash"++    it "accepts a normal context" $ do+      result <- runEff $ runConfigReader $ readContextConfig "work"+      case result of+        Left (InvalidNamespace _ _) -> expectationFailure "Did not expect InvalidNamespace for 'work'"+        _ -> pure ()++    it "returns Right empty for empty context" $ do+      result <- runEff $ runConfigReader $ readContextConfig ""+      result `shouldBe` Right Map.empty++  describe "config parse error propagation" $ do+    it "evalConfigFileIfExists returns Left for malformed Dhall" $ do+      withSystemTempDirectory "seihou-test" $ \tmpDir -> do+        let path = tmpDir <> "/bad.dhall"+        writeFile path "{ this is not valid dhall"+        result <- evalConfigFileIfExists path+        case result of+          Left err -> T.isInfixOf "Error reading config" err `shouldBe` True+          Right _ -> expectationFailure "Expected Left for malformed Dhall"
+ test/Seihou/Effect/ConfigWriterSpec.hs view
@@ -0,0 +1,99 @@+module Seihou.Effect.ConfigWriterSpec (tests) where++import Data.Map.Strict qualified as Map+import Effectful+import Seihou.Core.Types (ConfigScope (..))+import Seihou.Effect.ConfigWriter (ConfigWriter, deleteConfigValue, listConfigValues, writeConfigValue)+import Seihou.Effect.ConfigWriterPure (ConfigWriterState (..), emptyConfigWriterState, runConfigWriterPure)+import Test.Hspec+import Test.Tasty+import Test.Tasty.Hspec (testSpec)++tests :: IO TestTree+tests = testSpec "Seihou.Effect.ConfigWriter" spec++run :: ConfigWriterState -> Eff '[ConfigWriter] a -> (a, ConfigWriterState)+run st action = runPureEff $ runConfigWriterPure st action++spec :: Spec+spec = do+  describe "writeConfigValue + listConfigValues" $ do+    it "writes a value and lists it back" $ do+      let (result, _) = run emptyConfigWriterState $ do+            writeConfigValue ScopeLocal "project.name" "my-app"+            listConfigValues ScopeLocal+      result `shouldBe` Right (Map.fromList [("project.name", "my-app")])++    it "overwrites an existing value" $ do+      let initial = emptyConfigWriterState {cwLocal = Map.fromList [("key", "old")]}+          (result, _) = run initial $ do+            writeConfigValue ScopeLocal "key" "new"+            listConfigValues ScopeLocal+      result `shouldBe` Right (Map.fromList [("key", "new")])++    it "preserves other keys when writing" $ do+      let initial = emptyConfigWriterState {cwLocal = Map.fromList [("existing", "keep")]}+          (result, _) = run initial $ do+            writeConfigValue ScopeLocal "new-key" "added"+            listConfigValues ScopeLocal+      result `shouldBe` Right (Map.fromList [("existing", "keep"), ("new-key", "added")])++    it "writes to global scope independently of local" $ do+      let (resultLocal, _) = run emptyConfigWriterState $ do+            writeConfigValue ScopeGlobal "license" "MIT"+            listConfigValues ScopeLocal+          (resultGlobal, _) = run emptyConfigWriterState $ do+            writeConfigValue ScopeGlobal "license" "MIT"+            listConfigValues ScopeGlobal+      resultLocal `shouldBe` Right Map.empty+      resultGlobal `shouldBe` Right (Map.fromList [("license", "MIT")])++    it "writes to namespace scope" $ do+      let (result, _) = run emptyConfigWriterState $ do+            writeConfigValue (ScopeNamespace "haskell") "haskell.ghc" "9.12.2"+            listConfigValues (ScopeNamespace "haskell")+      result `shouldBe` Right (Map.fromList [("haskell.ghc", "9.12.2")])++    it "keeps namespace scopes independent" $ do+      let (r1, _) = run emptyConfigWriterState $ do+            writeConfigValue (ScopeNamespace "haskell") "key" "h-val"+            writeConfigValue (ScopeNamespace "nix") "key" "n-val"+            listConfigValues (ScopeNamespace "haskell")+          (r2, _) = run emptyConfigWriterState $ do+            writeConfigValue (ScopeNamespace "haskell") "key" "h-val"+            writeConfigValue (ScopeNamespace "nix") "key" "n-val"+            listConfigValues (ScopeNamespace "nix")+      r1 `shouldBe` Right (Map.fromList [("key", "h-val")])+      r2 `shouldBe` Right (Map.fromList [("key", "n-val")])++  describe "deleteConfigValue" $ do+    it "removes an existing value" $ do+      let initial = emptyConfigWriterState {cwLocal = Map.fromList [("key", "val")]}+          (result, _) = run initial $ do+            deleteConfigValue ScopeLocal "key"+            listConfigValues ScopeLocal+      result `shouldBe` Right Map.empty++    it "is a no-op for nonexistent key" $ do+      let initial = emptyConfigWriterState {cwLocal = Map.fromList [("keep", "me")]}+          (result, _) = run initial $ do+            deleteConfigValue ScopeLocal "nonexistent"+            listConfigValues ScopeLocal+      result `shouldBe` Right (Map.fromList [("keep", "me")])++    it "deletes from global scope" $ do+      let initial = emptyConfigWriterState {cwGlobal = Map.fromList [("license", "MIT")]}+          (result, _) = run initial $ do+            deleteConfigValue ScopeGlobal "license"+            listConfigValues ScopeGlobal+      result `shouldBe` Right Map.empty++  describe "state inspection" $ do+    it "returns final state with all changes" $ do+      let (_, finalState) = run emptyConfigWriterState $ do+            writeConfigValue ScopeLocal "local.key" "l"+            writeConfigValue ScopeGlobal "global.key" "g"+            writeConfigValue (ScopeNamespace "ns") "ns.key" "n"+      finalState.cwLocal `shouldBe` Map.fromList [("local.key", "l")]+      finalState.cwGlobal `shouldBe` Map.fromList [("global.key", "g")]+      Map.lookup "ns" (finalState.cwNamespaces) `shouldBe` Just (Map.fromList [("ns.key", "n")])
+ test/Seihou/Effect/FilesystemSpec.hs view
@@ -0,0 +1,147 @@+module Seihou.Effect.FilesystemSpec (tests) where++import Data.Map.Strict qualified as Map+import Data.Set qualified as Set+import Effectful+import Seihou.Effect.Filesystem+import Seihou.Effect.FilesystemInterp (runFilesystem)+import Seihou.Effect.FilesystemPure (PureFS (..), emptyFS, runFilesystemPure)+import System.Directory (removeDirectoryRecursive)+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.Effect.Filesystem" spec++-- | Run an action with the pure filesystem interpreter.+runPure :: PureFS -> Eff '[Filesystem] a -> (a, PureFS)+runPure fs action = runPureEff $ runFilesystemPure fs action++-- | Run an action with the real filesystem interpreter in a temp directory.+runReal :: (FilePath -> Eff '[Filesystem, IOE] a) -> IO a+runReal action =+  withSystemTempDirectory "seihou-fs-test" $ \tmpDir ->+    runEff $ runFilesystem (action tmpDir)++spec :: Spec+spec = do+  describe "pure interpreter" $ do+    it "writes and reads a file" $ do+      let (content, _) = runPure emptyFS $ do+            writeFileText "hello.txt" "hello world"+            readFileText "hello.txt"+      content `shouldBe` "hello world"++    it "doesFileExist returns False before write" $ do+      let (exists, _) = runPure emptyFS $ doesFileExist "missing.txt"+      exists `shouldBe` False++    it "doesFileExist returns True after write" $ do+      let (exists, _) = runPure emptyFS $ do+            writeFileText "test.txt" "data"+            doesFileExist "test.txt"+      exists `shouldBe` True++    it "copyFile copies content" $ do+      let initial = PureFS (Map.singleton "src.txt" "source content") Set.empty+          (content, _) = runPure initial $ do+            copyFile "src.txt" "dest.txt"+            readFileText "dest.txt"+      content `shouldBe` "source content"++    it "createDirectoryIfMissing creates a directory" $ do+      let (exists, _) = runPure emptyFS $ do+            createDirectoryIfMissing True "my/dir"+            doesDirectoryExist "my/dir"+      exists `shouldBe` True++    it "createDirectoryIfMissing is idempotent" $ do+      let (exists, _) = runPure emptyFS $ do+            createDirectoryIfMissing True "my/dir"+            createDirectoryIfMissing True "my/dir"+            doesDirectoryExist "my/dir"+      exists `shouldBe` True++    it "overwrite replaces content" $ do+      let (content, _) = runPure emptyFS $ do+            writeFileText "file.txt" "first"+            writeFileText "file.txt" "second"+            readFileText "file.txt"+      content `shouldBe` "second"++    it "returns final filesystem state" $ do+      let (_, fs) = runPure emptyFS $ do+            writeFileText "a.txt" "aaa"+            writeFileText "b.txt" "bbb"+      Map.size fs.files `shouldBe` 2++    it "getCurrentDirectory returns /pure-fs" $ do+      let (cwd, _) = runPure emptyFS getCurrentDirectory+      cwd `shouldBe` "/pure-fs"++  describe "real interpreter" $ do+    it "writes and reads a file" $ do+      content <- runReal $ \tmpDir -> do+        let path = tmpDir </> "hello.txt"+        writeFileText path "hello world"+        readFileText path+      content `shouldBe` "hello world"++    it "doesFileExist returns True after write" $ do+      exists <- runReal $ \tmpDir -> do+        let path = tmpDir </> "test.txt"+        writeFileText path "data"+        doesFileExist path+      exists `shouldBe` True++    it "doesFileExist returns False for nonexistent file" $ do+      exists <- runReal $ \tmpDir -> do+        doesFileExist (tmpDir </> "nope.txt")+      exists `shouldBe` False++    it "createDirectoryIfMissing creates nested directories" $ do+      exists <- runReal $ \tmpDir -> do+        let dirPath = tmpDir </> "a" </> "b" </> "c"+        createDirectoryIfMissing True dirPath+        doesDirectoryExist dirPath+      exists `shouldBe` True++    it "copyFile copies content" $ do+      content <- runReal $ \tmpDir -> do+        let src = tmpDir </> "src.txt"+            dest = tmpDir </> "dest.txt"+        writeFileText src "copy me"+        copyFile src dest+        readFileText dest+      content `shouldBe` "copy me"++    it "removeDirectoryIfEmpty removes an empty directory" $ do+      exists <- runReal $ \tmpDir -> do+        let dir = tmpDir </> "empty"+        createDirectoryIfMissing True dir+        removeDirectoryIfEmpty dir+        doesDirectoryExist dir+      exists `shouldBe` False++    it "removeDirectoryIfEmpty leaves a non-empty directory alone" $ do+      exists <- runReal $ \tmpDir -> do+        let dir = tmpDir </> "non-empty"+        createDirectoryIfMissing True dir+        writeFileText (dir </> "keep.txt") "."+        removeDirectoryIfEmpty dir+        doesDirectoryExist dir+      exists `shouldBe` True++    it "removeDirectoryIfEmpty is a no-op when the directory is missing" $ do+      -- Regression test: a migration chain that mixes MoveFile with a+      -- RunCommand 'rm -rf <src-dir>' previously crashed here because+      -- cleanupEmptyDirs revisits the source's parents after the+      -- shell step has already removed them.+      exists <- runReal $ \tmpDir -> do+        let dir = tmpDir </> "never-existed"+        removeDirectoryIfEmpty dir+        doesDirectoryExist dir+      exists `shouldBe` False
+ test/Seihou/Effect/LoggerSpec.hs view
@@ -0,0 +1,67 @@+module Seihou.Effect.LoggerSpec (tests) where++import Effectful+import Seihou.Core.Types (LogLevel (..))+import Seihou.Effect.Logger (logDebug, logError, logInfo, logWarn)+import Seihou.Effect.LoggerInterp (shouldLog)+import Seihou.Effect.LoggerPure (LoggerState (..), runLoggerPure)+import Test.Hspec+import Test.Tasty+import Test.Tasty.Hspec (testSpec)++tests :: IO TestTree+tests = testSpec "Seihou.Effect.Logger" spec++spec :: Spec+spec = do+  describe "runLoggerPure" $ do+    it "captures all four log levels in separate fields" $ do+      let ((), st) = runPureEff $ runLoggerPure $ do+            logDebug "d1"+            logInfo "i1"+            logWarn "w1"+            logError "e1"+      st.logDebugMsgs `shouldBe` ["d1"]+      st.logInfoMsgs `shouldBe` ["i1"]+      st.logWarnMsgs `shouldBe` ["w1"]+      st.logErrorMsgs `shouldBe` ["e1"]++    it "preserves message order within each field" $ do+      let ((), st) = runPureEff $ runLoggerPure $ do+            logInfo "first"+            logInfo "second"+            logInfo "third"+            logDebug "a"+            logDebug "b"+      st.logInfoMsgs `shouldBe` ["first", "second", "third"]+      st.logDebugMsgs `shouldBe` ["a", "b"]++    it "produces empty state when no messages are logged" $ do+      let ((), st) = runPureEff $ runLoggerPure $ pure ()+      st.logDebugMsgs `shouldBe` []+      st.logInfoMsgs `shouldBe` []+      st.logWarnMsgs `shouldBe` []+      st.logErrorMsgs `shouldBe` []++    it "returns the computation result alongside state" $ do+      let (result, st) = runPureEff $ runLoggerPure $ do+            logInfo "hello"+            pure (42 :: Int)+      result `shouldBe` 42+      st.logInfoMsgs `shouldBe` ["hello"]++  describe "shouldLog" $ do+    it "LogVerbose configured shows all levels" $ do+      shouldLog LogVerbose LogVerbose `shouldBe` True+      shouldLog LogVerbose LogNormal `shouldBe` True+      shouldLog LogVerbose LogQuiet `shouldBe` True++    it "LogNormal configured shows Normal and Quiet" $ do+      shouldLog LogNormal LogVerbose `shouldBe` False+      shouldLog LogNormal LogNormal `shouldBe` True+      shouldLog LogNormal LogQuiet `shouldBe` True++    it "LogQuiet configured shows only Quiet" $ do+      shouldLog LogQuiet LogVerbose `shouldBe` False+      shouldLog LogQuiet LogNormal `shouldBe` False+      shouldLog LogQuiet LogQuiet `shouldBe` True
+ test/Seihou/Effect/ManifestStoreSpec.hs view
@@ -0,0 +1,138 @@+module Seihou.Effect.ManifestStoreSpec (tests) where++import Data.Map.Strict qualified as Map+import Data.Set qualified as Set+import Data.Text qualified as T+import Data.Time (UTCTime, defaultTimeLocale, parseTimeOrError)+import Effectful+import Seihou.Core.Types+import Seihou.Effect.Filesystem (readFileText)+import Seihou.Effect.FilesystemInterp (runFilesystem)+import Seihou.Effect.FilesystemPure (PureFS (..), emptyFS, runFilesystemPure)+import Seihou.Effect.ManifestStore (readManifest, writeManifest)+import Seihou.Effect.ManifestStoreInterp (runManifestStore)+import Seihou.Effect.ManifestStorePure (runManifestStorePure)+import Seihou.Manifest.Types (emptyManifest)+import System.Directory (doesFileExist)+import System.FilePath ((</>))+import System.IO.Temp (withSystemTempDirectory)+import Test.Hspec+import Test.Tasty+import Test.Tasty.Hspec (testSpec)++tests :: IO TestTree+tests = testSpec "Seihou.Effect.ManifestStore" spec++fixedTime :: UTCTime+fixedTime = parseTimeOrError True defaultTimeLocale "%Y-%m-%dT%H:%M:%SZ" "2026-03-01T10:30:00Z"++sampleManifest :: Manifest+sampleManifest =+  (emptyManifest fixedTime)+    { modules =+        [ AppliedModule (ModuleName "haskell-base") emptyParentVars "/path/to/mod" Nothing fixedTime Nothing+        ],+      vars = Map.fromList [(VarName "project.name", "my-app")],+      files =+        Map.fromList+          [ ( "README.md",+              FileRecord (SHA256 "abc123") (ModuleName "haskell-base") Template fixedTime+            )+          ]+    }++spec :: Spec+spec = do+  describe "pure interpreter" $ do+    it "returns Right Nothing when no manifest stored" $ do+      let (result, _) = runPureEff $ runManifestStorePure Nothing readManifest+      result `shouldBe` Right Nothing++    it "returns Right (Just manifest) after write" $ do+      let (result, _) = runPureEff $ runManifestStorePure Nothing $ do+            writeManifest sampleManifest+            readManifest+      result `shouldBe` Right (Just sampleManifest)++    it "overwrites previous manifest" $ do+      let m2 = emptyManifest fixedTime+          (result, _) = runPureEff $ runManifestStorePure Nothing $ do+            writeManifest sampleManifest+            writeManifest m2+            readManifest+      result `shouldBe` Right (Just m2)++    it "returns final state" $ do+      let (_, finalState) = runPureEff $ runManifestStorePure Nothing $ do+            writeManifest sampleManifest+      finalState `shouldBe` Just sampleManifest++  describe "real interpreter (via pure filesystem)" $ do+    it "returns Right Nothing when manifest file does not exist" $ do+      let manifestPath = ".seihou/manifest.json"+          (result, _) =+            runPureEff $+              runFilesystemPure emptyFS $+                runManifestStore manifestPath readManifest+      result `shouldBe` Right Nothing++    it "roundtrips a manifest through filesystem" $ do+      let manifestPath = ".seihou/manifest.json"+          (result, _) =+            runPureEff $+              runFilesystemPure emptyFS $+                runManifestStore manifestPath $ do+                  writeManifest sampleManifest+                  readManifest+      result `shouldBe` Right (Just sampleManifest)++    it "writes valid JSON to the filesystem" $ do+      let manifestPath = ".seihou/manifest.json"+          (((), content), _) =+            runPureEff $+              runFilesystemPure emptyFS $ do+                runManifestStore manifestPath (writeManifest sampleManifest)+                c <- readFileText manifestPath+                pure ((), c)+      T.isInfixOf "\"version\":3" content `shouldBe` True+      T.isInfixOf "haskell-base" content `shouldBe` True+      T.isInfixOf "my-app" content `shouldBe` True++    it "renames the temp manifest away after a successful write" $ do+      let manifestPath = ".seihou/manifest.json"+          (_, finalFS) =+            runPureEff $+              runFilesystemPure emptyFS $+                runManifestStore manifestPath (writeManifest sampleManifest)+      Map.member manifestPath finalFS.files `shouldBe` True+      Map.member (manifestPath <> ".tmp") finalFS.files `shouldBe` False+      Set.member ".seihou" finalFS.dirs `shouldBe` True++    it "returns Left for corrupt JSON" $ do+      let manifestPath = ".seihou/manifest.json"+          corruptFS = PureFS (Map.fromList [(manifestPath, "{ this is not json }")]) Set.empty+          (result, _) =+            runPureEff $+              runFilesystemPure corruptFS $+                runManifestStore manifestPath readManifest+      case result of+        Left _err -> pure () -- Any Left is correct for corrupt JSON+        Right _ -> expectationFailure "Expected Left for corrupt JSON"++  describe "real filesystem interpreter" $ do+    it "writes valid JSON atomically and leaves no temp file" $ do+      withSystemTempDirectory "seihou-manifest-store" $ \tmpDir -> do+        let manifestPath = tmpDir </> ".seihou" </> "manifest.json"+            tmpPath = manifestPath <> ".tmp"+        runEff $+          runFilesystem $+            runManifestStore manifestPath (writeManifest sampleManifest)+        finalExists <- doesFileExist manifestPath+        tempExists <- doesFileExist tmpPath+        finalExists `shouldBe` True+        tempExists `shouldBe` False+        result <-+          runEff $+            runFilesystem $+              runManifestStore manifestPath readManifest+        result `shouldBe` Right (Just sampleManifest)
+ test/Seihou/Engine/ConflictSpec.hs view
@@ -0,0 +1,167 @@+module Seihou.Engine.ConflictSpec (tests) where++import Data.Text qualified as T+import Effectful+import Seihou.Core.Types+import Seihou.Effect.ConsolePure (ConsoleState (..), runConsolePure, runConsolePureNonInteractive)+import Seihou.Engine.Conflict (resolveConflicts, resolveConflictsInteractive)+import Seihou.Manifest.Hash (hashContent)+import Test.Hspec+import Test.Tasty+import Test.Tasty.Hspec (testSpec)++tests :: IO TestTree+tests = testSpec "Seihou.Engine.Conflict" spec++-- | Helper to make a ConflictFile with realistic hashes.+mkConflict :: FilePath -> ConflictFile+mkConflict path =+  ConflictFile+    { path = path,+      moduleName = ModuleName "test-module",+      manifestHash = hashContent "original content",+      diskHash = hashContent "user edited content",+      planContent = "new generated content"+    }++spec :: Spec+spec = do+  describe "resolveConflicts" $ do+    it "returns Just [] for empty conflict list" $ do+      let (result, _st) = runPureEff $ runConsolePure [] $ resolveConflicts False []+      result `shouldBe` Just []++    it "returns Just [] for empty conflict list with force" $ do+      let (result, _st) = runPureEff $ runConsolePure [] $ resolveConflicts True []+      result `shouldBe` Just []++    it "returns all AcceptNew when force is True" $ do+      let conflicts = [mkConflict "a.txt", mkConflict "b.txt", mkConflict "c.txt"]+          (result, _st) = runPureEff $ runConsolePure [] $ resolveConflicts True conflicts+      case result of+        Just resolved -> do+          length resolved `shouldBe` 3+          all (\(_, r) -> r == AcceptNew) resolved `shouldBe` True+        Nothing -> expectationFailure "Expected Just, got Nothing"++    it "returns Nothing in non-interactive mode without force" $ do+      let conflicts = [mkConflict "a.txt"]+          (result, _st) = runPureEff $ runConsolePureNonInteractive $ resolveConflicts False conflicts+      result `shouldBe` Nothing++    it "does not produce console output when force is True" $ do+      let conflicts = [mkConflict "a.txt"]+          (_result, st) = runPureEff $ runConsolePure [] $ resolveConflicts True conflicts+      st.consoleOutputs `shouldBe` []++  describe "resolveConflictsInteractive" $ do+    it "resolves accept with 'a'" $ do+      let conflict = mkConflict "readme.md"+          (result, _st) = runPureEff $ runConsolePure ["a"] $ resolveConflictsInteractive [conflict]+      case result of+        Just [(_, res)] -> res `shouldBe` AcceptNew+        _ -> expectationFailure "Expected Just with one AcceptNew resolution"++    it "resolves keep with 'k'" $ do+      let conflict = mkConflict "readme.md"+          (result, _st) = runPureEff $ runConsolePure ["k"] $ resolveConflictsInteractive [conflict]+      case result of+        Just [(_, res)] -> res `shouldBe` KeepCurrent+        _ -> expectationFailure "Expected Just with one KeepCurrent resolution"++    it "resolves skip with 's'" $ do+      let conflict = mkConflict "readme.md"+          (result, _st) = runPureEff $ runConsolePure ["s"] $ resolveConflictsInteractive [conflict]+      case result of+        Just [(_, res)] -> res `shouldBe` Skip+        _ -> expectationFailure "Expected Just with one Skip resolution"++    it "returns Nothing on abort with 'A'" $ do+      let conflicts = [mkConflict "a.txt", mkConflict "b.txt"]+          (result, _st) = runPureEff $ runConsolePure ["A"] $ resolveConflictsInteractive conflicts+      result `shouldBe` Nothing++    it "re-prompts on invalid input then accepts valid input" $ do+      let conflict = mkConflict "readme.md"+          (result, st) = runPureEff $ runConsolePure ["x", "a"] $ resolveConflictsInteractive [conflict]+      case result of+        Just [(_, res)] -> res `shouldBe` AcceptNew+        _ -> expectationFailure "Expected Just with one AcceptNew resolution"+      any (T.isInfixOf "Invalid choice") (st.consoleOutputs) `shouldBe` True++    it "resolves multiple files in order" $ do+      let conflicts = [mkConflict "a.txt", mkConflict "b.txt", mkConflict "c.txt"]+          (result, _st) = runPureEff $ runConsolePure ["a", "k", "s"] $ resolveConflictsInteractive conflicts+      case result of+        Just resolved -> do+          length resolved `shouldBe` 3+          map snd resolved `shouldBe` [AcceptNew, KeepCurrent, Skip]+          map ((.path) . fst) resolved `shouldBe` ["a.txt", "b.txt", "c.txt"]+        Nothing -> expectationFailure "Expected Just, got Nothing"++    it "abort on second file stops prompting" $ do+      let conflicts = [mkConflict "a.txt", mkConflict "b.txt", mkConflict "c.txt"]+          (result, st) = runPureEff $ runConsolePure ["a", "A"] $ resolveConflictsInteractive conflicts+      result `shouldBe` Nothing+      -- Should have prompted for a.txt and b.txt, but not c.txt+      let outputs = T.unlines (st.consoleOutputs)+      T.isInfixOf "a.txt" outputs `shouldBe` True+      T.isInfixOf "b.txt" outputs `shouldBe` True+      T.isInfixOf "c.txt" outputs `shouldBe` False++    it "outputs file paths in prompt messages" $ do+      let conflict = mkConflict "src/Main.hs"+          (_result, st) = runPureEff $ runConsolePure ["a"] $ resolveConflictsInteractive [conflict]+          outputs = T.unlines (st.consoleOutputs)+      T.isInfixOf "src/Main.hs" outputs `shouldBe` True+      T.isInfixOf "modified since last generation" outputs `shouldBe` True++    it "accepts full word inputs" $ do+      let conflicts = [mkConflict "a.txt", mkConflict "b.txt", mkConflict "c.txt", mkConflict "d.txt"]+          (result, _st) = runPureEff $ runConsolePure ["accept", "keep", "skip", "abort"] $ resolveConflictsInteractive conflicts+      -- abort on d.txt → Nothing+      result `shouldBe` Nothing++  describe "resolveConflicts integration" $ do+    it "dispatches to interactive prompts when interactive and not force" $ do+      let conflicts = [mkConflict "config.yaml", mkConflict "Makefile"]+          (result, st) = runPureEff $ runConsolePure ["k", "a"] $ resolveConflicts False conflicts+      case result of+        Just resolved -> do+          map snd resolved `shouldBe` [KeepCurrent, AcceptNew]+        Nothing -> expectationFailure "Expected Just, got Nothing"+      -- Verify prompt output was produced+      let outputs = T.unlines (st.consoleOutputs)+      T.isInfixOf "config.yaml" outputs `shouldBe` True+      T.isInfixOf "Makefile" outputs `shouldBe` True++    it "non-interactive mode produces no console output" $ do+      let conflicts = [mkConflict "a.txt"]+          (_result, st) = runPureEff $ runConsolePureNonInteractive $ resolveConflicts False conflicts+      st.consoleOutputs `shouldBe` []++    it "force mode preserves conflict file references in resolution" $ do+      let c = mkConflict "important.txt"+          (result, _st) = runPureEff $ runConsolePure [] $ resolveConflicts True [c]+      case result of+        Just [(resolved_c, AcceptNew)] ->+          resolved_c.path `shouldBe` "important.txt"+        _ -> expectationFailure "Expected Just with AcceptNew for important.txt"++    it "interactive abort via resolveConflicts returns Nothing" $ do+      let conflicts = [mkConflict "first.txt", mkConflict "second.txt"]+          (result, st) = runPureEff $ runConsolePure ["A"] $ resolveConflicts False conflicts+      result `shouldBe` Nothing+      -- Only first.txt was prompted before abort+      let outputs = T.unlines (st.consoleOutputs)+      T.isInfixOf "first.txt" outputs `shouldBe` True+      T.isInfixOf "second.txt" outputs `shouldBe` False++    it "choice prompt text includes all four options" $ do+      let conflict = mkConflict "test.txt"+          (_result, st) = runPureEff $ runConsolePure ["s"] $ resolveConflicts False [conflict]+          outputs = T.unlines (st.consoleOutputs)+      T.isInfixOf "[a]ccept" outputs `shouldBe` True+      T.isInfixOf "[k]eep" outputs `shouldBe` True+      T.isInfixOf "[s]kip" outputs `shouldBe` True+      T.isInfixOf "[A]bort" outputs `shouldBe` True
+ test/Seihou/Engine/DiffSpec.hs view
@@ -0,0 +1,314 @@+module Seihou.Engine.DiffSpec (tests) where++import Data.Map.Strict qualified as Map+import Data.Set (Set)+import Data.Set qualified as Set+import Data.Text (Text)+import Data.Time (UTCTime, defaultTimeLocale, parseTimeOrError)+import Effectful+import Seihou.Core.Types+import Seihou.Effect.FilesystemPure (PureFS (..), emptyFS, runFilesystemPure)+import Seihou.Engine.Diff (computeDiff)+import Seihou.Manifest.Hash (hashContent)+import Seihou.Manifest.Types (emptyManifest)+import Test.Hspec+import Test.Tasty+import Test.Tasty.Hspec (testSpec)++tests :: IO TestTree+tests = testSpec "Seihou.Engine.Diff" spec++fixedTime :: UTCTime+fixedTime = parseTimeOrError True defaultTimeLocale "%Y-%m-%dT%H:%M:%SZ" "2026-03-01T10:30:00Z"++modName :: ModuleName+modName = ModuleName "test-module"++-- | Run diff computation in pure filesystem.+runDiff :: PureFS -> Manifest -> Set ModuleName -> [(FilePath, Text, ModuleName, Maybe PatchOp)] -> DiffResult+runDiff fs manifest activeModules planned =+  fst $ runPureEff $ runFilesystemPure fs $ computeDiff manifest activeModules planned++-- | Helper to make a FileRecord from content.+mkRecord :: Text -> FileRecord+mkRecord content =+  FileRecord+    { hash = hashContent content,+      moduleName = modName,+      strategy = Template,+      generatedAt = fixedTime+    }++-- | Helper to create a manifest with file records (avoids ambiguous record update).+manifestWithFiles :: Map.Map FilePath FileRecord -> Manifest+manifestWithFiles recs =+  let base = emptyManifest fixedTime+   in Manifest+        { version = base.version,+          genAt = base.genAt,+          modules = base.modules,+          vars = base.vars,+          files = recs+        }++spec :: Spec+spec = do+  let active = Set.singleton modName++  describe "computeDiff" $ do+    it "classifies file in plan only (not on disk) as New" $ do+      let manifest = emptyManifest fixedTime+          planned = [("README.md", "# Hello", modName, Nothing)]+          result = runDiff emptyFS manifest active planned+      length (result.new) `shouldBe` 1+      (head result.new).path `shouldBe` "README.md"++    it "classifies file in plan + on disk (not in manifest) as Conflict" $ do+      let manifest = emptyManifest fixedTime+          planned = [("README.md", "# Hello", modName, Nothing)]+          fs = PureFS (Map.singleton "README.md" "existing content") mempty+          result = runDiff fs manifest active planned+      length (result.conflicts) `shouldBe` 1+      (head result.conflicts).path `shouldBe` "README.md"++    it "classifies patch op on existing file (not in manifest) as New, not Conflict" $ do+      let manifest = emptyManifest fixedTime+          planned = [(".gitignore", ".claude/\n", modName, Just AppendSection)]+          fs = PureFS (Map.singleton ".gitignore" ".seihou/\n") mempty+          result = runDiff fs manifest active planned+      length (result.conflicts) `shouldBe` 0+      length (result.new) `shouldBe` 1+      (head result.new).path `shouldBe` ".gitignore"++    it "classifies patch op on user-modified file (in manifest) as Modified, not Conflict" $ do+      let originalContent = "original"+          userContent = "user edited"+          patchContent = "new section"+          manifest = manifestWithFiles (Map.singleton "config.txt" (mkRecord originalContent))+          planned = [("config.txt", patchContent, modName, Just AppendSection)]+          fs = PureFS (Map.singleton "config.txt" userContent) mempty+          result = runDiff fs manifest active planned+      length (result.conflicts) `shouldBe` 0+      length (result.modified) `shouldBe` 1+      (head result.modified).path `shouldBe` "config.txt"++    it "classifies file in manifest + plan + disk (unchanged) as Unchanged" $ do+      let content = "# Hello World"+          manifest = manifestWithFiles (Map.singleton "README.md" (mkRecord content))+          planned = [("README.md", content, modName, Nothing)]+          fs = PureFS (Map.singleton "README.md" content) mempty+          result = runDiff fs manifest active planned+      length (result.unchanged) `shouldBe` 1+      head (result.unchanged) `shouldBe` "README.md"++    it "classifies file in manifest + plan + disk (plan changed) as Modified" $ do+      let oldContent = "# Hello"+          newContent = "# Hello World"+          manifest = manifestWithFiles (Map.singleton "README.md" (mkRecord oldContent))+          planned = [("README.md", newContent, modName, Nothing)]+          -- Disk matches manifest (user didn't touch it)+          fs = PureFS (Map.singleton "README.md" oldContent) mempty+          result = runDiff fs manifest active planned+      length (result.modified) `shouldBe` 1+      (head result.modified).path `shouldBe` "README.md"+      (head result.modified).newContent `shouldBe` newContent++    it "classifies file in manifest + plan + disk (user modified) as Conflict" $ do+      let originalContent = "# Hello"+          userContent = "# Hello - edited by user"+          planContent = "# Hello World"+          manifest = manifestWithFiles (Map.singleton "README.md" (mkRecord originalContent))+          planned = [("README.md", planContent, modName, Nothing)]+          -- Disk was modified by user (doesn't match manifest)+          fs = PureFS (Map.singleton "README.md" userContent) mempty+          result = runDiff fs manifest active planned+      length (result.conflicts) `shouldBe` 1+      (head result.conflicts).path `shouldBe` "README.md"+      (head result.conflicts).planContent `shouldBe` planContent++    it "classifies file in manifest only (on disk) as Orphaned" $ do+      let content = "orphaned content"+          manifest =+            (emptyManifest fixedTime :: Manifest)+              { files = Map.singleton "old-file.txt" (mkRecord content)+              }+          planned = [] :: [(FilePath, Text, ModuleName, Maybe PatchOp)] -- module no longer produces this file+          fs = PureFS (Map.singleton "old-file.txt" content) mempty+          result = runDiff fs manifest active planned+      length (result.orphaned) `shouldBe` 1+      (head result.orphaned).path `shouldBe` "old-file.txt"++    it "classifies file in manifest only (not on disk) as Orphaned" $ do+      let content = "deleted content"+          manifest =+            (emptyManifest fixedTime :: Manifest)+              { files = Map.singleton "deleted.txt" (mkRecord content)+              }+          planned = [] :: [(FilePath, Text, ModuleName, Maybe PatchOp)]+          result = runDiff emptyFS manifest active planned+      length (result.orphaned) `shouldBe` 1+      (head result.orphaned).path `shouldBe` "deleted.txt"++    it "classifies file in manifest + plan (deleted from disk) as Modified" $ do+      let content = "recreate me"+          manifest =+            (emptyManifest fixedTime :: Manifest)+              { files = Map.singleton "gone.txt" (mkRecord content)+              }+          planned = [("gone.txt", "new version", modName, Nothing)]+          result = runDiff emptyFS manifest active planned+      length (result.modified) `shouldBe` 1+      (head result.modified).path `shouldBe` "gone.txt"++    it "handles mixed classifications" $ do+      let existingContent = "existing"+          manifest =+            (emptyManifest fixedTime :: Manifest)+              { files =+                  Map.fromList+                    [ ("unchanged.txt", mkRecord existingContent),+                      ("orphaned.txt", mkRecord "orphan")+                    ]+              }+          planned =+            [ ("unchanged.txt", existingContent, modName, Nothing),+              ("new-file.txt", "brand new", modName, Nothing)+            ]+          fs =+            PureFS+              (Map.fromList [("unchanged.txt", existingContent), ("orphaned.txt", "orphan")])+              mempty+          result = runDiff fs manifest active planned+      length (result.new) `shouldBe` 1+      length (result.unchanged) `shouldBe` 1+      length (result.orphaned) `shouldBe` 1+      length (result.modified) `shouldBe` 0+      length (result.conflicts) `shouldBe` 0++    it "handles empty manifest and empty plan" $ do+      let manifest = emptyManifest fixedTime+          result = runDiff emptyFS manifest Set.empty ([] :: [(FilePath, Text, ModuleName, Maybe PatchOp)])+      result.new `shouldBe` []+      result.modified `shouldBe` []+      result.unchanged `shouldBe` []+      result.conflicts `shouldBe` []+      result.orphaned `shouldBe` []++    it "does not classify files from inactive modules as orphaned" $ do+      let otherMod = ModuleName "other-module"+          content = "from other module"+          record =+            FileRecord+              { hash = hashContent content,+                moduleName = otherMod,+                strategy = Template,+                generatedAt = fixedTime+              }+          manifest = manifestWithFiles (Map.singleton "other.txt" record)+          planned = [("new.txt", "new content", modName, Nothing)]+          activeModules = Set.singleton modName -- "test-module", NOT "other-module"+          fs = PureFS (Map.singleton "other.txt" content) mempty+          result = runDiff fs manifest activeModules planned+      length (result.orphaned) `shouldBe` 0+      length (result.new) `shouldBe` 1++    it "classifies files from active modules as orphaned" $ do+      let content = "active module content"+          manifest = manifestWithFiles (Map.singleton "old.txt" (mkRecord content))+          planned = [("new.txt", "new content", modName, Nothing)]+          activeModules = Set.singleton modName -- file belongs to active module+          fs = PureFS (Map.singleton "old.txt" content) mempty+          result = runDiff fs manifest activeModules planned+      length (result.orphaned) `shouldBe` 1+      (head result.orphaned).path `shouldBe` "old.txt"++    it "mixed active/inactive: only orphans active module's missing files" $ do+      let otherMod = ModuleName "other-module"+          otherRecord =+            FileRecord+              { hash = hashContent "other content",+                moduleName = otherMod,+                strategy = Copy,+                generatedAt = fixedTime+              }+          manifest =+            manifestWithFiles+              ( Map.fromList+                  [ ("active-old.txt", mkRecord "active old"),+                    ("other.txt", otherRecord)+                  ]+              )+          -- active module now produces a different file, dropping active-old.txt+          planned = [("active-new.txt", "active new", modName, Nothing)]+          activeModules = Set.singleton modName+          fs =+            PureFS+              (Map.fromList [("active-old.txt", "active old"), ("other.txt", "other content")])+              mempty+          result = runDiff fs manifest activeModules planned+      -- active-old.txt is orphaned (active module no longer produces it)+      length (result.orphaned) `shouldBe` 1+      (head result.orphaned).path `shouldBe` "active-old.txt"+      -- other.txt is invisible (inactive module), not orphaned+      length (result.new) `shouldBe` 1+      (head result.new).path `shouldBe` "active-new.txt"++    it "plan targeting inactive module's file on disk is classified as Conflict" $ do+      let otherMod = ModuleName "other-module"+          otherRecord =+            FileRecord+              { hash = hashContent "other content",+                moduleName = otherMod,+                strategy = Template,+                generatedAt = fixedTime+              }+          manifest = manifestWithFiles (Map.singleton "shared.txt" otherRecord)+          -- active module wants to write to same path owned by inactive module+          planned = [("shared.txt", "new content from active", modName, Nothing)]+          activeModules = Set.singleton modName+          fs = PureFS (Map.singleton "shared.txt" "other content") mempty+          result = runDiff fs manifest activeModules planned+      -- File exists on disk but not in active manifest → Conflict+      length (result.conflicts) `shouldBe` 1+      (head result.conflicts).path `shouldBe` "shared.txt"++    it "handles multiple active modules scoping independently" $ do+      let modA = ModuleName "module-a"+          modB = ModuleName "module-b"+          modC = ModuleName "module-c"+          mkRec m content =+            FileRecord+              { hash = hashContent content,+                moduleName = m,+                strategy = Template,+                generatedAt = fixedTime+              }+          manifest =+            manifestWithFiles+              ( Map.fromList+                  [ ("from-a.txt", mkRec modA "a content"),+                    ("from-b.txt", mkRec modB "b content"),+                    ("from-c.txt", mkRec modC "c content")+                  ]+              )+          -- Running modules A and B (not C); A still produces its file, B drops its file+          planned = [("from-a.txt", "a content", modA, Nothing)]+          activeModules = Set.fromList [modA, modB]+          fs =+            PureFS+              ( Map.fromList+                  [ ("from-a.txt", "a content"),+                    ("from-b.txt", "b content"),+                    ("from-c.txt", "c content")+                  ]+              )+              mempty+          result = runDiff fs manifest activeModules planned+      -- from-a.txt unchanged (active, still produced)+      length (result.unchanged) `shouldBe` 1+      -- from-b.txt orphaned (active module B no longer produces it)+      length (result.orphaned) `shouldBe` 1+      (head result.orphaned).path `shouldBe` "from-b.txt"+      -- from-c.txt invisible (inactive module C)+      length (result.new) `shouldBe` 0+      length (result.conflicts) `shouldBe` 0
+ test/Seihou/Engine/ExecuteSpec.hs view
@@ -0,0 +1,208 @@+module Seihou.Engine.ExecuteSpec (tests) where++import Data.Map.Strict qualified as Map+import Data.Text qualified as T+import Data.Time (UTCTime, defaultTimeLocale, parseTimeOrError)+import Effectful+import Seihou.Core.Types+import Seihou.Effect.Filesystem (doesDirectoryExist, doesFileExist, readFileText)+import Seihou.Effect.FilesystemPure (PureFS (..), emptyFS, runFilesystemPure)+import Seihou.Engine.Execute (dryRunPlan, executePlan)+import Seihou.Manifest.Hash (hashContent)+import Test.Hspec+import Test.Tasty+import Test.Tasty.Hspec (testSpec)++tests :: IO TestTree+tests = testSpec "Seihou.Engine.Execute" spec++fixedTime :: UTCTime+fixedTime = parseTimeOrError True defaultTimeLocale "%Y-%m-%dT%H:%M:%SZ" "2026-03-01T10:30:00Z"++modName :: ModuleName+modName = ModuleName "test-module"++-- | Run execution in pure filesystem and return results + final FS state.+runExec :: [Operation] -> ((Map.Map FilePath FileRecord, PureFS), PureFS)+runExec ops =+  runPureEff $+    runFilesystemPure emptyFS $ do+      records <- executePlan "/project" ops Map.empty modName fixedTime+      fs <- pure () -- just to get the final state via the tuple+      pure (records, emptyFS) -- placeholder; actual FS state is in the outer tuple++-- | More useful helper: run and return records + the pure FS state.+runExecFS :: PureFS -> [Operation] -> (Map.Map FilePath FileRecord, PureFS)+runExecFS initial ops =+  runPureEff $+    runFilesystemPure initial $+      executePlan "/project" ops Map.empty modName fixedTime++spec :: Spec+spec = do+  describe "executePlan" $ do+    it "writes a file via WriteFileOp" $ do+      let ops = [WriteFileOp "hello.txt" "hello world" Template]+          (records, fs) = runExecFS emptyFS ops+      Map.member "hello.txt" records `shouldBe` True+      Map.lookup "/project/hello.txt" (fs.files) `shouldBe` Just "hello world"++    it "creates a directory via CreateDirOp" $ do+      let ops = [CreateDirOp "src"]+          ((exists, _), _) =+            runPureEff $+              runFilesystemPure emptyFS $ do+                _ <- executePlan "/project" ops Map.empty modName fixedTime+                e <- doesDirectoryExist "/project/src"+                pure (e, ())+      exists `shouldBe` True++    it "produces FileRecord with correct hash" $ do+      let content = "test content"+          ops = [WriteFileOp "test.txt" content Template]+          (records, _) = runExecFS emptyFS ops+          record = records Map.! "test.txt"+      record.hash `shouldBe` hashContent content++    it "produces FileRecord with correct module name" $ do+      let ops = [WriteFileOp "test.txt" "data" Template]+          (records, _) = runExecFS emptyFS ops+          record = records Map.! "test.txt"+      record.moduleName `shouldBe` modName++    it "produces FileRecord with correct timestamp" $ do+      let ops = [WriteFileOp "test.txt" "data" Template]+          (records, _) = runExecFS emptyFS ops+          record = records Map.! "test.txt"+      record.generatedAt `shouldBe` fixedTime++    it "handles multiple operations" $ do+      let ops =+            [ CreateDirOp "src",+              WriteFileOp "README.md" "# Hello" Template,+              WriteFileOp "src/Main.hs" "module Main where" Template+            ]+          (records, fs) = runExecFS emptyFS ops+      Map.size records `shouldBe` 2+      Map.lookup "/project/README.md" (fs.files) `shouldBe` Just "# Hello"+      Map.lookup "/project/src/Main.hs" (fs.files) `shouldBe` Just "module Main where"++    it "skips RunCommandOp" $ do+      let ops = [RunCommandOp "echo hello" Nothing]+          (records, _) = runExecFS emptyFS ops+      Map.size records `shouldBe` 0++    it "handles CopyFileOp by reading source and writing dest" $ do+      let initial = PureFS (Map.singleton "/source/file.txt" "copied content") mempty+          ops = [CopyFileOp "/source/file.txt" "dest.txt"]+          (records, fs) = runExecFS initial ops+      Map.member "dest.txt" records `shouldBe` True+      Map.lookup "/project/dest.txt" (fs.files) `shouldBe` Just "copied content"++    it "records Template strategy in FileRecord" $ do+      let ops = [WriteFileOp "test.txt" "content" Template]+          (records, _) = runExecFS emptyFS ops+          record = records Map.! "test.txt"+      record.strategy `shouldBe` Template++    it "records Copy strategy in FileRecord" $ do+      let ops = [WriteFileOp "test.txt" "content" Copy]+          (records, _) = runExecFS emptyFS ops+          record = records Map.! "test.txt"+      record.strategy `shouldBe` Copy++    it "records DhallText strategy in FileRecord" $ do+      let ops = [WriteFileOp "test.txt" "content" DhallText]+          (records, _) = runExecFS emptyFS ops+          record = records Map.! "test.txt"+      record.strategy `shouldBe` DhallText++    it "records Structured strategy in FileRecord" $ do+      let ops = [WriteFileOp "test.json" "{}" Structured]+          (records, _) = runExecFS emptyFS ops+          record = records Map.! "test.json"+      record.strategy `shouldBe` Structured++    it "executes PatchFileOp AppendFile on existing file" $ do+      let initial = PureFS (Map.singleton "/project/README.md" "# Title\n") mempty+          ops = [PatchFileOp "README.md" "extra line\n" AppendFile Template modName]+          (records, fs) = runExecFS initial ops+      Map.member "README.md" records `shouldBe` True+      let content = fs.files Map.! "/project/README.md"+      T.isInfixOf "# Title" content `shouldBe` True+      T.isInfixOf "extra line" content `shouldBe` True++    it "executes PatchFileOp PrependFile on existing file" $ do+      let initial = PureFS (Map.singleton "/project/README.md" "# Title\n") mempty+          ops = [PatchFileOp "README.md" "header\n" PrependFile Template modName]+          (records, fs) = runExecFS initial ops+      Map.member "README.md" records `shouldBe` True+      let content = fs.files Map.! "/project/README.md"+      T.isInfixOf "header" content `shouldBe` True+      T.isInfixOf "# Title" content `shouldBe` True++    it "executes PatchFileOp AppendSection with section markers" $ do+      let initial = PureFS (Map.singleton "/project/README.md" "# Title\n") mempty+          ops = [PatchFileOp "README.md" "section content\n" AppendSection Template modName]+          (records, fs) = runExecFS initial ops+      Map.member "README.md" records `shouldBe` True+      let content = fs.files Map.! "/project/README.md"+      T.isInfixOf "# Title" content `shouldBe` True+      T.isInfixOf "seihou:test-module" content `shouldBe` True+      T.isInfixOf "section content" content `shouldBe` True++    it "executes PatchFileOp on nonexistent file (creates from empty)" $ do+      let ops = [PatchFileOp "new.txt" "new content\n" AppendFile Template modName]+          (records, fs) = runExecFS emptyFS ops+      Map.member "new.txt" records `shouldBe` True+      let content = fs.files Map.! "/project/new.txt"+      T.isInfixOf "new content" content `shouldBe` True++    it "executes PatchFileOp AppendLineIfAbsent, skipping existing lines" $ do+      let initial = PureFS (Map.singleton "/project/.gitignore" "node_modules/\n.env\n") mempty+          ops = [PatchFileOp ".gitignore" ".env\n.claude/\n" AppendLineIfAbsent Template modName]+          (records, fs) = runExecFS initial ops+      Map.member ".gitignore" records `shouldBe` True+      let content = fs.files Map.! "/project/.gitignore"+      content `shouldBe` "node_modules/\n.env\n.claude/\n"++    it "executes PatchFileOp AppendLineIfAbsent idempotently" $ do+      let initial = PureFS (Map.singleton "/project/.gitignore" "node_modules/\n.claude/\n") mempty+          ops = [PatchFileOp ".gitignore" ".claude/\n" AppendLineIfAbsent Template modName]+          (records, fs) = runExecFS initial ops+      Map.member ".gitignore" records `shouldBe` True+      let content = fs.files Map.! "/project/.gitignore"+      content `shouldBe` "node_modules/\n.claude/\n"++  describe "dryRunPlan" $ do+    it "formats WriteFileOp" $ do+      let result = dryRunPlan [WriteFileOp "README.md" "content" Template]+      T.isInfixOf "write" result `shouldBe` True+      T.isInfixOf "README.md" result `shouldBe` True++    it "formats CreateDirOp" $ do+      let result = dryRunPlan [CreateDirOp "src"]+      T.isInfixOf "mkdir" result `shouldBe` True+      T.isInfixOf "src" result `shouldBe` True++    it "formats CopyFileOp" $ do+      let result = dryRunPlan [CopyFileOp "src.txt" "dest.txt"]+      T.isInfixOf "copy" result `shouldBe` True++    it "formats RunCommandOp" $ do+      let result = dryRunPlan [RunCommandOp "echo hello" Nothing]+      T.isInfixOf "run" result `shouldBe` True++    it "returns message for empty plan" $ do+      let result = dryRunPlan []+      T.isInfixOf "No operations" result `shouldBe` True++    it "formats PatchFileOp" $ do+      let result = dryRunPlan [PatchFileOp "README.md" "content" AppendSection Template (ModuleName "nix-flake")]+      T.isInfixOf "patch" result `shouldBe` True+      T.isInfixOf "README.md" result `shouldBe` True+      T.isInfixOf "nix-flake" result `shouldBe` True++    it "does not include file content" $ do+      let result = dryRunPlan [WriteFileOp "secret.txt" "super secret" Template]+      T.isInfixOf "super secret" result `shouldBe` False
+ test/Seihou/Engine/MigrateSpec.hs view
@@ -0,0 +1,286 @@+module Seihou.Engine.MigrateSpec (tests) where++import Data.Map.Strict qualified as Map+import Data.Set qualified as Set+import Data.Text (Text)+import Data.Time (UTCTime, defaultTimeLocale, parseTimeOrError)+import Effectful+import Seihou.Core.Migration+  ( Migration (..),+    MigrationOp (..),+    MigrationPlan (..),+  )+import Seihou.Core.Types+import Seihou.Core.Version (Version, parseVersion)+import Seihou.Effect.FilesystemPure (PureFS (..), runFilesystemPure)+import Seihou.Effect.ProcessPure (runProcessPure)+import Seihou.Engine.Migrate+  ( ExecutedMigrationPlan (..),+    MigrationExecError (..),+    MigrationFileStatus (..),+    MigrationOpInstance (..),+    classifyMigration,+    executeMigration,+  )+import Seihou.Manifest.Hash (hashContent)+import Seihou.Manifest.Types (emptyManifest)+import Test.Hspec+import Test.Tasty+import Test.Tasty.Hspec (testSpec)++tests :: IO TestTree+tests = testSpec "Seihou.Engine.Migrate" spec++-- ----------------------------------------------------------------------------+-- Fixtures and helpers+-- ----------------------------------------------------------------------------++fixedTime :: UTCTime+fixedTime = parseTimeOrError True defaultTimeLocale "%Y-%m-%dT%H:%M:%SZ" "2026-04-01T10:00:00Z"++migrateTime :: UTCTime+migrateTime = parseTimeOrError True defaultTimeLocale "%Y-%m-%dT%H:%M:%SZ" "2026-04-25T11:00:00Z"++modName :: ModuleName+modName = ModuleName "demo"++mkV :: Text -> Version+mkV t = case parseVersion t of+  Just v -> v+  Nothing -> error ("MigrateSpec.mkV: bad version " <> show t)++-- | Build a manifest with the given files (path, content) all owned by+-- the demo module. The manifest hash is the SHA256 of the content, so+-- safe-vs-conflict can be exercised by mutating the on-disk content.+mkManifest :: [(FilePath, Text)] -> Manifest+mkManifest entries =+  (emptyManifest fixedTime)+    { modules =+        [ AppliedModule+            { name = modName,+              parentVars = emptyParentVars,+              source = "/installed/demo",+              moduleVersion = Just "1.0.0",+              appliedAt = fixedTime,+              removal = Nothing+            }+        ],+      files =+        Map.fromList+          [ ( path,+              FileRecord+                { hash = hashContent content,+                  moduleName = modName,+                  strategy = Template,+                  generatedAt = fixedTime+                }+            )+          | (path, content) <- entries+          ]+    }++-- | Build an in-memory filesystem from (path, content) pairs.+mkFS :: [(FilePath, Text)] -> PureFS+mkFS entries = PureFS (Map.fromList entries) Set.empty++-- | Single-step plan wrapping the supplied ops.+chain1 :: Text -> Text -> [MigrationOp] -> MigrationPlan+chain1 fromV toV ops =+  MigrationPlan+    { planModule = "demo",+      planFrom = mkV fromV,+      planTo = mkV toV,+      planSteps = [Migration {from = fromV, to = toV, ops}]+    }++runClassifyResult :: PureFS -> Manifest -> MigrationPlan -> Either MigrationExecError ExecutedMigrationPlan+runClassifyResult fs manifest c =+  fst $+    runPureEff $+      runFilesystemPure fs $+        classifyMigration manifest c++runClassify :: PureFS -> Manifest -> MigrationPlan -> ExecutedMigrationPlan+runClassify fs manifest c =+  case runClassifyResult fs manifest c of+    Right plan -> plan+    Left err -> error ("MigrateSpec.runClassify: unexpected error " <> show err)++runExecute ::+  PureFS ->+  Manifest ->+  ExecutedMigrationPlan ->+  Bool ->+  (Either MigrationExecError Manifest, PureFS)+runExecute fs manifest plan force =+  runPureEff $+    runFilesystemPure fs $+      runProcessPure [] $+        executeMigration force plan manifest migrateTime++-- ----------------------------------------------------------------------------+-- Spec+-- ----------------------------------------------------------------------------++spec :: Spec+spec = do+  describe "classifyMigration" $ do+    it "marks a move-file safe when disk hash matches manifest" $ do+      let manifest = mkManifest [("app/Main.hs", "module Main where")]+          fs = mkFS [("app/Main.hs", "module Main where")]+          c = chain1 "1.0.0" "2.0.0" [MoveFile "app/Main.hs" "src/Main.hs"]+          plan = runClassify fs manifest c+      plan.planOps `shouldBe` [MoveFileInst "app/Main.hs" "src/Main.hs" MFSafe]++    it "marks a move-file as conflict when disk content differs" $ do+      let manifest = mkManifest [("app/Main.hs", "original")]+          fs = mkFS [("app/Main.hs", "user-edited")]+          c = chain1 "1.0.0" "2.0.0" [MoveFile "app/Main.hs" "src/Main.hs"]+          plan = runClassify fs manifest c+      plan.planOps `shouldBe` [MoveFileInst "app/Main.hs" "src/Main.hs" MFConflict]++    it "marks a delete-file as gone when the file is absent" $ do+      let manifest = mkManifest [("Setup.hs", "boring")]+          fs = mkFS [] -- file already deleted on disk+          c = chain1 "1.0.0" "2.0.0" [DeleteFile "Setup.hs"]+          plan = runClassify fs manifest c+      plan.planOps `shouldBe` [DeleteFileInst "Setup.hs" MFGone]++    it "rejects a delete-dir path with a parent directory segment" $ do+      let manifest = mkManifest []+          fs = mkFS []+          c = chain1 "1.0.0" "2.0.0" [DeleteDir "../outside"]+          result = runClassifyResult fs manifest c+      result `shouldBe` Left (MigrationUnsafePath "delete-dir path" "../outside" "path must not contain '..' segment: ../outside")++    it "rejects a move-file destination with a parent directory segment" $ do+      let manifest = mkManifest [("README.md", "hello")]+          fs = mkFS [("README.md", "hello")]+          c = chain1 "1.0.0" "2.0.0" [MoveFile "README.md" "../outside"]+          result = runClassifyResult fs manifest c+      result `shouldBe` Left (MigrationUnsafePath "move-file destination" "../outside" "path must not contain '..' segment: ../outside")++    it "rejects a run-command workDir with a parent directory segment" $ do+      let manifest = mkManifest []+          fs = mkFS []+          c = chain1 "1.0.0" "2.0.0" [RunCommand "echo unsafe" (Just "../outside")]+          result = runClassifyResult fs manifest c+      result `shouldBe` Left (MigrationUnsafePath "run-command workDir" "../outside" "path must not contain '..' segment: ../outside")++  describe "executeMigration" $ do+    it "renames a single safe file and rewrites the manifest" $ do+      let manifest = mkManifest [("app/Main.hs", "x")]+          fs = mkFS [("app/Main.hs", "x")]+          c = chain1 "1.0.0" "2.0.0" [MoveFile "app/Main.hs" "src/Main.hs"]+          plan = runClassify fs manifest c+          (result, fs') = runExecute fs manifest plan False+      case result of+        Right m -> do+          Map.member "src/Main.hs" m.files `shouldBe` True+          Map.member "app/Main.hs" m.files `shouldBe` False+          (head m.modules).moduleVersion `shouldBe` Just "2.0.0"+        Left err -> expectationFailure ("expected Right, got: " <> show err)+      Map.member "src/Main.hs" fs'.files `shouldBe` True+      Map.member "app/Main.hs" fs'.files `shouldBe` False++    it "refuses on conflict without --force and leaves disk untouched" $ do+      let manifest = mkManifest [("app/Main.hs", "original")]+          fs = mkFS [("app/Main.hs", "user-edited")]+          c = chain1 "1.0.0" "2.0.0" [MoveFile "app/Main.hs" "src/Main.hs"]+          plan = runClassify fs manifest c+          (result, fs') = runExecute fs manifest plan False+      result `shouldBe` Left (MigrationConflict ["app/Main.hs"])+      -- Disk untouched: original src still there, dest absent.+      Map.member "app/Main.hs" fs'.files `shouldBe` True+      Map.member "src/Main.hs" fs'.files `shouldBe` False++    it "executes through a conflict when force is set" $ do+      let manifest = mkManifest [("app/Main.hs", "original")]+          fs = mkFS [("app/Main.hs", "user-edited")]+          c = chain1 "1.0.0" "2.0.0" [MoveFile "app/Main.hs" "src/Main.hs"]+          plan = runClassify fs manifest c+          (result, fs') = runExecute fs manifest plan True+      case result of+        Right m -> do+          Map.member "src/Main.hs" m.files `shouldBe` True+          Map.member "app/Main.hs" m.files `shouldBe` False+        Left err -> expectationFailure ("expected Right, got: " <> show err)+      -- The user-edited content rode along: the move is a key rename in+      -- the pure FS, so the bytes follow the rename.+      Map.lookup "src/Main.hs" fs'.files `shouldBe` Just "user-edited"++    it "moves a directory, rewriting all contained manifest entries" $ do+      let manifest =+            mkManifest+              [ ("app/Main.hs", "main"),+                ("app/Lib.hs", "lib")+              ]+          fs =+            mkFS+              [ ("app/Main.hs", "main"),+                ("app/Lib.hs", "lib")+              ]+          c = chain1 "1.0.0" "2.0.0" [MoveDir "app" "src"]+          plan = runClassify fs manifest c+          (result, fs') = runExecute fs manifest plan False+      case result of+        Right m -> do+          Map.keys m.files `shouldMatchList` ["src/Main.hs", "src/Lib.hs"]+        Left err -> expectationFailure ("expected Right, got: " <> show err)+      Map.keys fs'.files `shouldMatchList` ["src/Main.hs", "src/Lib.hs"]++    it "is a no-op for a delete-file whose target is already gone" $ do+      let manifest = mkManifest [("Setup.hs", "boring")]+          fs = mkFS [] -- absent on disk+          c = chain1 "1.0.0" "2.0.0" [DeleteFile "Setup.hs"]+          plan = runClassify fs manifest c+          (result, fs') = runExecute fs manifest plan False+      case result of+        Right m -> Map.member "Setup.hs" m.files `shouldBe` False+        Left err -> expectationFailure ("expected Right, got: " <> show err)+      Map.null fs'.files `shouldBe` True++    it "deletes a directory and drops every manifest entry under it" $ do+      let manifest =+            mkManifest+              [ ("legacy/a.hs", "a"),+                ("legacy/sub/b.hs", "b"),+                ("keep.hs", "k")+              ]+          fs =+            mkFS+              [ ("legacy/a.hs", "a"),+                ("legacy/sub/b.hs", "b"),+                ("keep.hs", "k")+              ]+          c = chain1 "1.0.0" "2.0.0" [DeleteDir "legacy"]+          plan = runClassify fs manifest c+          (result, fs') = runExecute fs manifest plan False+      case result of+        Right m -> Map.keys m.files `shouldBe` ["keep.hs"]+        Left err -> expectationFailure ("expected Right, got: " <> show err)+      Map.keys fs'.files `shouldBe` ["keep.hs"]++    it "applies a chain of two migrations in declaration order" $ do+      -- 1.0.0 → 2.0.0: move app → src+      -- 2.0.0 → 3.0.0: delete src/Main.hs+      let manifest = mkManifest [("app/Main.hs", "x")]+          fs = mkFS [("app/Main.hs", "x")]+          chain =+            MigrationPlan+              { planModule = "demo",+                planFrom = mkV "1.0.0",+                planTo = mkV "3.0.0",+                planSteps =+                  [ Migration "1.0.0" "2.0.0" [MoveDir "app" "src"],+                    Migration "2.0.0" "3.0.0" [DeleteFile "src/Main.hs"]+                  ]+              }+          plan = runClassify fs manifest chain+          (result, fs') = runExecute fs manifest plan False+      case result of+        Right m -> do+          Map.null m.files `shouldBe` True+          (head m.modules).moduleVersion `shouldBe` Just "3.0.0"+        Left err -> expectationFailure ("expected Right, got: " <> show err)+      Map.null fs'.files `shouldBe` True
+ test/Seihou/Engine/PlanSpec.hs view
@@ -0,0 +1,959 @@+module Seihou.Engine.PlanSpec (tests) where++import Data.Aeson qualified as Aeson+import Data.Map.Strict qualified as Map+import Data.Text qualified as T+import Data.Text.Encoding qualified as T+import Data.Yaml qualified as Yaml+import Seihou.Core.Module (loadModule)+import Seihou.Core.Types+import Seihou.Engine.Plan+import System.Directory (createDirectoryIfMissing, getCurrentDirectory)+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.Engine.Plan" spec++-- | Helper to create a temp fixture with files in a @files/@ subdirectory.+withFixture :: [(FilePath, String)] -> (FilePath -> IO a) -> IO a+withFixture files action = do+  withSystemTempDirectory "seihou-plan-test" $ \tmpDir -> do+    mapM_ (createFile tmpDir) files+    action tmpDir+  where+    createFile base (path, content) = do+      let full = base </> "files" </> path+          dir = takeDir full+      createDirectoryIfMissing True dir+      writeFile full content++    takeDir = reverse . dropWhile (/= '/') . reverse++spec :: Spec+spec = do+  describe "parentDirs" $ do+    it "returns empty for a file in the root" $ do+      parentDirs "README.md" `shouldBe` []++    it "returns one directory for a file one level deep" $ do+      parentDirs "src/Lib.hs" `shouldBe` ["src"]++    it "returns two directories for a file two levels deep" $ do+      parentDirs "a/b/c.txt" `shouldBe` ["a", "a/b"]++    it "returns three directories for a file three levels deep" $ do+      parentDirs "a/b/c/d.txt" `shouldBe` ["a", "a/b", "a/b/c"]++  describe "compilePlan" $ do+    it "compiles a Copy step" $ do+      withFixture [("data.txt", "raw content")] $ \baseDir -> do+        let modul =+              Module+                { name = "test",+                  version = Nothing,+                  description = Nothing,+                  vars = [],+                  exports = [],+                  prompts = [],+                  steps = [Step Copy "data.txt" "data.txt" Nothing Nothing],+                  commands = [],+                  dependencies = [],+                  removal = Nothing,+                  migrations = []+                }+            vars = Map.empty+        result <- compilePlan baseDir modul vars+        case result of+          Right ops -> ops `shouldBe` [WriteFileOp "data.txt" "raw content" Copy]+          Left errs -> expectationFailure ("Expected Right, got: " <> show errs)++    it "compiles a Template step with rendering" $ do+      withFixture [("hello.tpl", "Hello, {{name}}!")] $ \baseDir -> do+        let modul =+              Module+                { name = "test",+                  version = Nothing,+                  description = Nothing,+                  vars = [],+                  exports = [],+                  prompts = [],+                  steps = [Step Template "hello.tpl" "hello.txt" Nothing Nothing],+                  commands = [],+                  dependencies = [],+                  removal = Nothing,+                  migrations = []+                }+            vars = Map.fromList [("name", VText "world")]+        result <- compilePlan baseDir modul vars+        case result of+          Right ops -> ops `shouldBe` [WriteFileOp "hello.txt" "Hello, world!" Template]+          Left errs -> expectationFailure ("Expected Right, got: " <> show errs)++    it "skips step when condition is false" $ do+      withFixture [("data.txt", "content")] $ \baseDir -> do+        let modul =+              Module+                { name = "test",+                  version = Nothing,+                  description = Nothing,+                  vars = [],+                  exports = [],+                  prompts = [],+                  steps = [Step Copy "data.txt" "data.txt" (Just (ExprLit False)) Nothing],+                  commands = [],+                  dependencies = [],+                  removal = Nothing,+                  migrations = []+                }+            vars = Map.empty+        result <- compilePlan baseDir modul vars+        case result of+          Right ops -> ops `shouldBe` []+          Left errs -> expectationFailure ("Expected Right, got: " <> show errs)++    it "includes step when condition is true" $ do+      withFixture [("data.txt", "content")] $ \baseDir -> do+        let modul =+              Module+                { name = "test",+                  version = Nothing,+                  description = Nothing,+                  vars = [],+                  exports = [],+                  prompts = [],+                  steps = [Step Copy "data.txt" "data.txt" (Just (ExprLit True)) Nothing],+                  commands = [],+                  dependencies = [],+                  removal = Nothing,+                  migrations = []+                }+            vars = Map.empty+        result <- compilePlan baseDir modul vars+        case result of+          Right ops -> ops `shouldBe` [WriteFileOp "data.txt" "content" Copy]+          Left errs -> expectationFailure ("Expected Right, got: " <> show errs)++    it "evaluates IsSet condition correctly" $ do+      withFixture [("LICENSE", "MIT License")] $ \baseDir -> do+        let modul =+              Module+                { name = "test",+                  version = Nothing,+                  description = Nothing,+                  vars = [],+                  exports = [],+                  prompts = [],+                  steps = [Step Copy "LICENSE" "LICENSE" (Just (ExprIsSet "license")) Nothing],+                  commands = [],+                  dependencies = [],+                  removal = Nothing,+                  migrations = []+                }+        -- Variable IS set+        let vars1 = Map.fromList [("license", VText "MIT")]+        result1 <- compilePlan baseDir modul vars1+        case result1 of+          Right ops -> ops `shouldBe` [WriteFileOp "LICENSE" "MIT License" Copy]+          Left errs -> expectationFailure ("Expected Right, got: " <> show errs)+        -- Variable is NOT set+        let vars2 = Map.empty+        result2 <- compilePlan baseDir modul vars2+        case result2 of+          Right ops -> ops `shouldBe` []+          Left errs -> expectationFailure ("Expected Right, got: " <> show errs)++    it "expands destination path with placeholders" $ do+      withFixture [("pkg.cabal.tpl", "name: {{name}}\n")] $ \baseDir -> do+        let modul =+              Module+                { name = "test",+                  version = Nothing,+                  description = Nothing,+                  vars = [],+                  exports = [],+                  prompts = [],+                  steps = [Step Template "pkg.cabal.tpl" "{{name}}.cabal" Nothing Nothing],+                  commands = [],+                  dependencies = [],+                  removal = Nothing,+                  migrations = []+                }+            vars = Map.fromList [("name", VText "my-app")]+        result <- compilePlan baseDir modul vars+        case result of+          Right ops -> ops `shouldBe` [WriteFileOp "my-app.cabal" "name: my-app\n" Template]+          Left errs -> expectationFailure ("Expected Right, got: " <> show errs)++    it "rejects a rendered destination with a parent directory segment" $ do+      withFixture [("README.md.tpl", "content")] $ \baseDir -> do+        let modul =+              Module+                { name = "test",+                  version = Nothing,+                  description = Nothing,+                  vars = [],+                  exports = [],+                  prompts = [],+                  steps = [Step Template "README.md.tpl" "{{project.name}}/README.md" Nothing Nothing],+                  commands = [],+                  dependencies = [],+                  removal = Nothing,+                  migrations = []+                }+            vars = Map.fromList [("project.name", VText "..")]+        result <- compilePlan baseDir modul vars+        case result of+          Left errs -> do+            length errs `shouldBe` 1+            T.isInfixOf "rendered destination" (errs !! 0) `shouldBe` True+            T.isInfixOf "must not contain '..' segment" (errs !! 0) `shouldBe` True+          Right _ -> expectationFailure "Expected Left"++    it "rejects a rendered absolute destination" $ do+      withFixture [("README.md.tpl", "content")] $ \baseDir -> do+        let modul =+              Module+                { name = "test",+                  version = Nothing,+                  description = Nothing,+                  vars = [],+                  exports = [],+                  prompts = [],+                  steps = [Step Template "README.md.tpl" "{{project.name}}/README.md" Nothing Nothing],+                  commands = [],+                  dependencies = [],+                  removal = Nothing,+                  migrations = []+                }+            vars = Map.fromList [("project.name", VText "/tmp/outside")]+        result <- compilePlan baseDir modul vars+        case result of+          Left errs -> do+            length errs `shouldBe` 1+            T.isInfixOf "rendered destination" (errs !! 0) `shouldBe` True+            T.isInfixOf "must be relative" (errs !! 0) `shouldBe` True+          Right _ -> expectationFailure "Expected Left"++    it "allows dots inside a rendered destination filename" $ do+      withFixture [("README.md.tpl", "content")] $ \baseDir -> do+        let modul =+              Module+                { name = "test",+                  version = Nothing,+                  description = Nothing,+                  vars = [],+                  exports = [],+                  prompts = [],+                  steps = [Step Template "README.md.tpl" "docs/README.v2.md" Nothing Nothing],+                  commands = [],+                  dependencies = [],+                  removal = Nothing,+                  migrations = []+                }+            vars = Map.empty+        result <- compilePlan baseDir modul vars+        case result of+          Right ops -> ops `shouldBe` [CreateDirOp "docs", WriteFileOp "docs/README.v2.md" "content" Template]+          Left errs -> expectationFailure ("Expected Right, got: " <> show errs)++    it "creates parent directories" $ do+      withFixture [("Lib.hs.tpl", "module Lib where\n")] $ \baseDir -> do+        let modul =+              Module+                { name = "test",+                  version = Nothing,+                  description = Nothing,+                  vars = [],+                  exports = [],+                  prompts = [],+                  steps = [Step Template "Lib.hs.tpl" "src/Lib.hs" Nothing Nothing],+                  commands = [],+                  dependencies = [],+                  removal = Nothing,+                  migrations = []+                }+            vars = Map.empty+        result <- compilePlan baseDir modul vars+        case result of+          Right ops ->+            ops `shouldBe` [CreateDirOp "src", WriteFileOp "src/Lib.hs" "module Lib where\n" Template]+          Left errs -> expectationFailure ("Expected Right, got: " <> show errs)++    it "deduplicates parent directory operations" $ do+      withFixture [("A.hs.tpl", "module A\n"), ("B.hs.tpl", "module B\n")] $ \baseDir -> do+        let modul =+              Module+                { name = "test",+                  version = Nothing,+                  description = Nothing,+                  vars = [],+                  exports = [],+                  prompts = [],+                  steps =+                    [ Step Template "A.hs.tpl" "src/A.hs" Nothing Nothing,+                      Step Template "B.hs.tpl" "src/B.hs" Nothing Nothing+                    ],+                  commands = [],+                  dependencies = [],+                  removal = Nothing,+                  migrations = []+                }+            vars = Map.empty+        result <- compilePlan baseDir modul vars+        case result of+          Right ops ->+            ops+              `shouldBe` [ CreateDirOp "src",+                           WriteFileOp "src/A.hs" "module A\n" Template,+                           WriteFileOp "src/B.hs" "module B\n" Template+                         ]+          Left errs -> expectationFailure ("Expected Right, got: " <> show errs)++    it "propagates template error for unresolved placeholder" $ do+      withFixture [("hello.tpl", "Hello, {{missing}}!")] $ \baseDir -> do+        let modul =+              Module+                { name = "test",+                  version = Nothing,+                  description = Nothing,+                  vars = [],+                  exports = [],+                  prompts = [],+                  steps = [Step Template "hello.tpl" "hello.txt" Nothing Nothing],+                  commands = [],+                  dependencies = [],+                  removal = Nothing,+                  migrations = []+                }+            vars = Map.empty+        result <- compilePlan baseDir modul vars+        case result of+          Left errs -> do+            length errs `shouldBe` 1+            T.isInfixOf "missing" (errs !! 0) `shouldBe` True+          Right _ -> expectationFailure "Expected Left"++    it "compiles a DhallText step" $ do+      withFixture [("greeting.dhall", "\"Hello, {{name}}!\"")] $ \baseDir -> do+        let modul =+              Module+                { name = "test",+                  version = Nothing,+                  description = Nothing,+                  vars = [],+                  exports = [],+                  prompts = [],+                  steps = [Step DhallText "greeting.dhall" "greeting.txt" Nothing Nothing],+                  commands = [],+                  dependencies = [],+                  removal = Nothing,+                  migrations = []+                }+            vars = Map.fromList [("name", VText "world")]+        result <- compilePlan baseDir modul vars+        case result of+          Right ops -> ops `shouldBe` [WriteFileOp "greeting.txt" "Hello, world!" DhallText]+          Left errs -> expectationFailure ("Expected Right, got: " <> show errs)++    it "compiles a DhallText step with Dhall string interpolation" $ do+      let dhallContent =+            "let name = \"{{project.name}}\"\n\+            \let version = \"{{project.version}}\"\n\+            \in \"name: ${name}\\nversion: ${version}\\n\""+      withFixture [("pkg.dhall", T.unpack dhallContent)] $ \baseDir -> do+        let modul =+              Module+                { name = "test",+                  version = Nothing,+                  description = Nothing,+                  vars = [],+                  exports = [],+                  prompts = [],+                  steps = [Step DhallText "pkg.dhall" "pkg.txt" Nothing Nothing],+                  commands = [],+                  dependencies = [],+                  removal = Nothing,+                  migrations = []+                }+            vars = Map.fromList [("project.name", VText "my-app"), ("project.version", VText "0.1.0.0")]+        result <- compilePlan baseDir modul vars+        case result of+          Right ops -> ops `shouldBe` [WriteFileOp "pkg.txt" "name: my-app\nversion: 0.1.0.0\n" DhallText]+          Left errs -> expectationFailure ("Expected Right, got: " <> show errs)++    it "reports error for invalid Dhall in DhallText step" $ do+      withFixture [("bad.dhall", "this is not valid dhall {")] $ \baseDir -> do+        let modul =+              Module+                { name = "test",+                  version = Nothing,+                  description = Nothing,+                  vars = [],+                  exports = [],+                  prompts = [],+                  steps = [Step DhallText "bad.dhall" "out.txt" Nothing Nothing],+                  commands = [],+                  dependencies = [],+                  removal = Nothing,+                  migrations = []+                }+            vars = Map.empty+        result <- compilePlan baseDir modul vars+        case result of+          Left errs -> do+            length errs `shouldSatisfy` (>= 1)+            T.isInfixOf "Dhall" (errs !! 0) `shouldBe` True+          Right _ -> expectationFailure "Expected Left"++    it "compiles a Structured step to JSON" $ do+      withFixture [("data.json.gen", "{ name = \"{{name}}\", version = \"1.0.0\" }\n")] $ \baseDir -> do+        let modul =+              Module+                { name = "test",+                  version = Nothing,+                  description = Nothing,+                  vars = [],+                  exports = [],+                  prompts = [],+                  steps = [Step Structured "data.json.gen" "data.json" Nothing Nothing],+                  commands = [],+                  dependencies = [],+                  removal = Nothing,+                  migrations = []+                }+            vars = Map.fromList [("name", VText "my-app")]+        result <- compilePlan baseDir modul vars+        case result of+          Right ops -> do+            length ops `shouldBe` 1+            let (WriteFileOp dest content strat) = ops !! 0+            dest `shouldBe` "data.json"+            strat `shouldBe` Structured+            -- Parse the JSON to verify it's valid+            case Aeson.eitherDecodeStrict (T.encodeUtf8 content) of+              Left err -> expectationFailure ("Invalid JSON: " <> err)+              Right (val :: Aeson.Value) -> do+                val `shouldBe` Aeson.object [("name", Aeson.String "my-app"), ("version", Aeson.String "1.0.0")]+          Left errs -> expectationFailure ("Expected Right, got: " <> show errs)++    it "compiles a Structured step to YAML" $ do+      withFixture [("config.yaml.gen", "{ name = \"{{name}}\", debug = False }\n")] $ \baseDir -> do+        let modul =+              Module+                { name = "test",+                  version = Nothing,+                  description = Nothing,+                  vars = [],+                  exports = [],+                  prompts = [],+                  steps = [Step Structured "config.yaml.gen" "config.yaml" Nothing Nothing],+                  commands = [],+                  dependencies = [],+                  removal = Nothing,+                  migrations = []+                }+            vars = Map.fromList [("name", VText "my-app")]+        result <- compilePlan baseDir modul vars+        case result of+          Right ops -> do+            length ops `shouldBe` 1+            let (WriteFileOp dest content strat) = ops !! 0+            dest `shouldBe` "config.yaml"+            strat `shouldBe` Structured+            -- Parse the YAML to verify it's valid+            case Yaml.decodeEither' (T.encodeUtf8 content) of+              Left err -> expectationFailure ("Invalid YAML: " <> show err)+              Right (val :: Aeson.Value) -> do+                val `shouldBe` Aeson.object [("debug", Aeson.Bool False), ("name", Aeson.String "my-app")]+          Left errs -> expectationFailure ("Expected Right, got: " <> show errs)++    it "reports error for Structured step with unconvertible Dhall expression" $ do+      -- A lambda cannot be converted to JSON+      withFixture [("bad.gen", "\\(x : Text) -> x\n")] $ \baseDir -> do+        let modul =+              Module+                { name = "test",+                  version = Nothing,+                  description = Nothing,+                  vars = [],+                  exports = [],+                  prompts = [],+                  steps = [Step Structured "bad.gen" "out.json" Nothing Nothing],+                  commands = [],+                  dependencies = [],+                  removal = Nothing,+                  migrations = []+                }+            vars = Map.empty+        result <- compilePlan baseDir modul vars+        case result of+          Left errs -> do+            length errs `shouldSatisfy` (>= 1)+            T.isInfixOf "Cannot convert" (errs !! 0) `shouldBe` True+          Right _ -> expectationFailure "Expected Left"++    it "reports error for unknown output format in Structured step" $ do+      withFixture [("data.gen", "{ name = \"test\" }\n")] $ \baseDir -> do+        let modul =+              Module+                { name = "test",+                  version = Nothing,+                  description = Nothing,+                  vars = [],+                  exports = [],+                  prompts = [],+                  steps = [Step Structured "data.gen" "output.txt" Nothing Nothing],+                  commands = [],+                  dependencies = [],+                  removal = Nothing,+                  migrations = []+                }+            vars = Map.empty+        result <- compilePlan baseDir modul vars+        case result of+          Left errs -> do+            length errs `shouldSatisfy` (>= 1)+            T.isInfixOf "unsupported output format" (errs !! 0) `shouldBe` True+          Right _ -> expectationFailure "Expected Left"++    it "compiles haskell-base fixture end-to-end" $ do+      cwd <- getCurrentDirectory+      let fixtures = cwd </> "test" </> "fixtures"+      result <- loadModule [fixtures] "haskell-base"+      case result of+        Left err -> expectationFailure ("Failed to load module: " <> show err)+        Right modul -> do+          let vars =+                Map.fromList+                  [ ("project.name", VText "my-app"),+                    ("project.version", VText "0.1.0.0"),+                    ("license", VText "MIT")+                  ]+          planResult <- compilePlan (fixtures </> "haskell-base") modul vars+          case planResult of+            Left errs -> expectationFailure ("Expected Right, got: " <> show errs)+            Right ops -> do+              -- Should have operations for README, src/Lib.hs, LICENSE, my-app.cabal, and cabal.project+              let writeOps = [op | op@(WriteFileOp _ _ _) <- ops]+                  dirOps = [op | op@(CreateDirOp _) <- ops]+              length writeOps `shouldBe` 5+              -- README.md with rendered content+              (writeOps !! 0).dest `shouldBe` "README.md"+              T.isInfixOf "my-app" ((writeOps !! 0).content) `shouldBe` True+              -- src/Lib.hs+              (writeOps !! 1).dest `shouldBe` "src/Lib.hs"+              -- LICENSE (copy)+              (writeOps !! 2).dest `shouldBe` "LICENSE"+              -- my-app.cabal (dest expanded from {{project.name}}.cabal)+              (writeOps !! 3).dest `shouldBe` "my-app.cabal"+              T.isInfixOf "my-app" ((writeOps !! 3).content) `shouldBe` True+              -- cabal.project (DhallText)+              (writeOps !! 4).dest `shouldBe` "cabal.project"+              T.isInfixOf "my-app" ((writeOps !! 4).content) `shouldBe` True+              -- Should have CreateDirOp for src/+              dirOps `shouldSatisfy` any (\op -> op.path == "src")+              -- Should have RunCommandOp for the command+              let cmdOps = [op | op@(RunCommandOp _ _) <- ops]+              length cmdOps `shouldBe` 1+              (cmdOps !! 0).command `shouldBe` "echo 'Project generated'"++    it "compiles a Template step with patch = AppendFile to PatchFileOp" $ do+      withFixture [("section.tpl", "appended content")] $ \baseDir -> do+        let modul =+              Module+                { name = "patch-mod",+                  version = Nothing,+                  description = Nothing,+                  vars = [],+                  exports = [],+                  prompts = [],+                  steps = [Step Template "section.tpl" "README.md" Nothing (Just AppendFile)],+                  commands = [],+                  dependencies = [],+                  removal = Nothing,+                  migrations = []+                }+            vars = Map.empty+        result <- compilePlan baseDir modul vars+        case result of+          Right ops ->+            ops `shouldBe` [PatchFileOp "README.md" "appended content" AppendFile Template "patch-mod"]+          Left errs -> expectationFailure ("Expected Right, got: " <> show errs)++    it "compiles a Template step with patch = AppendSection to PatchFileOp" $ do+      withFixture [("section.tpl", "section {{name}}")] $ \baseDir -> do+        let modul =+              Module+                { name = "section-mod",+                  version = Nothing,+                  description = Nothing,+                  vars = [],+                  exports = [],+                  prompts = [],+                  steps = [Step Template "section.tpl" "README.md" Nothing (Just AppendSection)],+                  commands = [],+                  dependencies = [],+                  removal = Nothing,+                  migrations = []+                }+            vars = Map.fromList [("name", VText "test")]+        result <- compilePlan baseDir modul vars+        case result of+          Right ops ->+            ops `shouldBe` [PatchFileOp "README.md" "section test" AppendSection Template "section-mod"]+          Left errs -> expectationFailure ("Expected Right, got: " <> show errs)++    it "compiles a Template step containing {{#if}} and selects the then-branch" $ do+      let tpl = "prefix\n{{#if Eq flag true}}hot\n{{/if}}suffix\n"+      withFixture [("conditional.tpl", tpl)] $ \baseDir -> do+        let modul =+              Module+                { name = "cond-mod",+                  version = Nothing,+                  description = Nothing,+                  vars = [],+                  exports = [],+                  prompts = [],+                  steps = [Step Template "conditional.tpl" "out.txt" Nothing Nothing],+                  commands = [],+                  dependencies = [],+                  removal = Nothing,+                  migrations = []+                }+            vars = Map.fromList [("flag", VBool True)]+        result <- compilePlan baseDir modul vars+        case result of+          Right ops ->+            ops `shouldBe` [WriteFileOp "out.txt" "prefix\nhot\nsuffix\n" Template]+          Left errs -> expectationFailure ("Expected Right, got: " <> show errs)++    it "compiles a Template step containing {{#if}} and drops the untaken branch" $ do+      let tpl = "prefix\n{{#if Eq flag true}}hot\n{{/if}}suffix\n"+      withFixture [("conditional.tpl", tpl)] $ \baseDir -> do+        let modul =+              Module+                { name = "cond-mod",+                  version = Nothing,+                  description = Nothing,+                  vars = [],+                  exports = [],+                  prompts = [],+                  steps = [Step Template "conditional.tpl" "out.txt" Nothing Nothing],+                  commands = [],+                  dependencies = [],+                  removal = Nothing,+                  migrations = []+                }+            vars = Map.fromList [("flag", VBool False)]+        result <- compilePlan baseDir modul vars+        case result of+          Right ops ->+            ops `shouldBe` [WriteFileOp "out.txt" "prefix\nsuffix\n" Template]+          Left errs -> expectationFailure ("Expected Right, got: " <> show errs)++    it "compiles a Template patch step whose body uses {{#if}}" $ do+      let tpl = "base{{#if Eq flag true}} extra{{/if}}\n"+      withFixture [("patch.tpl", tpl)] $ \baseDir -> do+        let modul =+              Module+                { name = "patch-cond-mod",+                  version = Nothing,+                  description = Nothing,+                  vars = [],+                  exports = [],+                  prompts = [],+                  steps = [Step Template "patch.tpl" "README.md" Nothing (Just AppendFile)],+                  commands = [],+                  dependencies = [],+                  removal = Nothing,+                  migrations = []+                }+            vars = Map.fromList [("flag", VBool True)]+        result <- compilePlan baseDir modul vars+        case result of+          Right ops ->+            ops+              `shouldBe` [PatchFileOp "README.md" "base extra\n" AppendFile Template "patch-cond-mod"]+          Left errs -> expectationFailure ("Expected Right, got: " <> show errs)++    it "compiles a Copy step with patch = PrependFile to PatchFileOp" $ do+      withFixture [("header.txt", "header line\n")] $ \baseDir -> do+        let modul =+              Module+                { name = "header-mod",+                  version = Nothing,+                  description = Nothing,+                  vars = [],+                  exports = [],+                  prompts = [],+                  steps = [Step Copy "header.txt" "out.txt" Nothing (Just PrependFile)],+                  commands = [],+                  dependencies = [],+                  removal = Nothing,+                  migrations = []+                }+            vars = Map.empty+        result <- compilePlan baseDir modul vars+        case result of+          Right ops ->+            ops `shouldBe` [PatchFileOp "out.txt" "header line\n" PrependFile Copy "header-mod"]+          Left errs -> expectationFailure ("Expected Right, got: " <> show errs)++    it "rejects Structured strategy with patch operation" $ do+      withFixture [("data.gen", "{ name = \"test\" }\n")] $ \baseDir -> do+        let modul =+              Module+                { name = "test",+                  version = Nothing,+                  description = Nothing,+                  vars = [],+                  exports = [],+                  prompts = [],+                  steps = [Step Structured "data.gen" "data.json" Nothing (Just AppendFile)],+                  commands = [],+                  dependencies = [],+                  removal = Nothing,+                  migrations = []+                }+            vars = Map.empty+        result <- compilePlan baseDir modul vars+        case result of+          Left errs -> do+            length errs `shouldSatisfy` (>= 1)+            T.isInfixOf "Structured" (errs !! 0) `shouldBe` True+          Right _ -> expectationFailure "Expected Left"++    it "compiles unconditional command to RunCommandOp" $ do+      withFixture [("data.txt", "content")] $ \baseDir -> do+        let modul =+              Module+                { name = "test",+                  version = Nothing,+                  description = Nothing,+                  vars = [],+                  exports = [],+                  prompts = [],+                  steps = [Step Copy "data.txt" "data.txt" Nothing Nothing],+                  commands = [Command "echo hello" Nothing Nothing],+                  dependencies = [],+                  removal = Nothing,+                  migrations = []+                }+            vars = Map.empty+        result <- compilePlan baseDir modul vars+        case result of+          Right ops -> do+            let cmdOps = [op | op@(RunCommandOp _ _) <- ops]+            length cmdOps `shouldBe` 1+            (cmdOps !! 0).command `shouldBe` "echo hello"+            (cmdOps !! 0).workDir `shouldBe` Nothing+          Left errs -> expectationFailure ("Expected Right, got: " <> show errs)++    it "skips command when condition is false" $ do+      withFixture [("data.txt", "content")] $ \baseDir -> do+        let modul =+              Module+                { name = "test",+                  version = Nothing,+                  description = Nothing,+                  vars = [],+                  exports = [],+                  prompts = [],+                  steps = [Step Copy "data.txt" "data.txt" Nothing Nothing],+                  commands = [Command "echo skip" Nothing (Just (ExprLit False))],+                  dependencies = [],+                  removal = Nothing,+                  migrations = []+                }+            vars = Map.empty+        result <- compilePlan baseDir modul vars+        case result of+          Right ops -> do+            let cmdOps = [op | op@(RunCommandOp _ _) <- ops]+            length cmdOps `shouldBe` 0+          Left errs -> expectationFailure ("Expected Right, got: " <> show errs)++    it "includes command when condition is true" $ do+      withFixture [("data.txt", "content")] $ \baseDir -> do+        let modul =+              Module+                { name = "test",+                  version = Nothing,+                  description = Nothing,+                  vars = [],+                  exports = [],+                  prompts = [],+                  steps = [Step Copy "data.txt" "data.txt" Nothing Nothing],+                  commands = [Command "echo yes" Nothing (Just (ExprIsSet "name"))],+                  dependencies = [],+                  removal = Nothing,+                  migrations = []+                }+            vars = Map.fromList [("name", VText "test")]+        result <- compilePlan baseDir modul vars+        case result of+          Right ops -> do+            let cmdOps = [op | op@(RunCommandOp _ _) <- ops]+            length cmdOps `shouldBe` 1+          Left errs -> expectationFailure ("Expected Right, got: " <> show errs)++    it "places commands after file operations in compiled plan" $ do+      withFixture [("data.txt", "content")] $ \baseDir -> do+        let modul =+              Module+                { name = "test",+                  version = Nothing,+                  description = Nothing,+                  vars = [],+                  exports = [],+                  prompts = [],+                  steps = [Step Copy "data.txt" "data.txt" Nothing Nothing],+                  commands = [Command "echo post" Nothing Nothing],+                  dependencies = [],+                  removal = Nothing,+                  migrations = []+                }+            vars = Map.empty+        result <- compilePlan baseDir modul vars+        case result of+          Right ops -> do+            let isFileOp (WriteFileOp {}) = True+                isFileOp (CreateDirOp {}) = True+                isFileOp (CopyFileOp {}) = True+                isFileOp (PatchFileOp {}) = True+                isFileOp _ = False+                isCmdOp (RunCommandOp {}) = True+                isCmdOp _ = False+                fileOps = filter isFileOp ops+                cmdOps = filter isCmdOp ops+            -- Commands should come after all file ops+            ops `shouldBe` (fileOps ++ cmdOps)+          Left errs -> expectationFailure ("Expected Right, got: " <> show errs)++    it "compiles command with workDir" $ do+      withFixture [("data.txt", "content")] $ \baseDir -> do+        let modul =+              Module+                { name = "test",+                  version = Nothing,+                  description = Nothing,+                  vars = [],+                  exports = [],+                  prompts = [],+                  steps = [Step Copy "data.txt" "data.txt" Nothing Nothing],+                  commands = [Command "npm install" (Just "subdir") Nothing],+                  dependencies = [],+                  removal = Nothing,+                  migrations = []+                }+            vars = Map.empty+        result <- compilePlan baseDir modul vars+        case result of+          Right ops -> do+            let cmdOps = [op | op@(RunCommandOp _ _) <- ops]+            length cmdOps `shouldBe` 1+            (cmdOps !! 0).workDir `shouldBe` Just "subdir"+          Left errs -> expectationFailure ("Expected Right, got: " <> show errs)++    it "interpolates {{var}} in command run field" $ do+      withFixture [("data.txt", "content")] $ \baseDir -> do+        let modul =+              Module+                { name = "test",+                  version = Nothing,+                  description = Nothing,+                  vars = [],+                  exports = [],+                  prompts = [],+                  steps = [Step Copy "data.txt" "data.txt" Nothing Nothing],+                  commands = [Command "echo {{name}}" Nothing Nothing],+                  dependencies = [],+                  removal = Nothing,+                  migrations = []+                }+            vars = Map.fromList [("name", VText "my-app")]+        result <- compilePlan baseDir modul vars+        case result of+          Right ops -> do+            let cmdOps = [op | op@(RunCommandOp _ _) <- ops]+            length cmdOps `shouldBe` 1+            (cmdOps !! 0).command `shouldBe` "echo my-app"+          Left errs -> expectationFailure ("Expected Right, got: " <> show errs)++    it "interpolates {{var}} in command workDir field" $ do+      withFixture [("data.txt", "content")] $ \baseDir -> do+        let modul =+              Module+                { name = "test",+                  version = Nothing,+                  description = Nothing,+                  vars = [],+                  exports = [],+                  prompts = [],+                  steps = [Step Copy "data.txt" "data.txt" Nothing Nothing],+                  commands = [Command "cabal build" (Just "{{name}}") Nothing],+                  dependencies = [],+                  removal = Nothing,+                  migrations = []+                }+            vars = Map.fromList [("name", VText "my-app")]+        result <- compilePlan baseDir modul vars+        case result of+          Right ops -> do+            let cmdOps = [op | op@(RunCommandOp _ _) <- ops]+            length cmdOps `shouldBe` 1+            (cmdOps !! 0).workDir `shouldBe` Just "my-app"+          Left errs -> expectationFailure ("Expected Right, got: " <> show errs)++    it "rejects a rendered command workDir with a parent directory segment" $ do+      withFixture [] $ \baseDir -> do+        let modul =+              Module+                { name = "test",+                  version = Nothing,+                  description = Nothing,+                  vars = [],+                  exports = [],+                  prompts = [],+                  steps = [],+                  commands = [Command "cabal build" (Just "{{project.name}}") Nothing],+                  dependencies = [],+                  removal = Nothing,+                  migrations = []+                }+            vars = Map.fromList [("project.name", VText "..")]+        result <- compilePlan baseDir modul vars+        case result of+          Left errs -> do+            length errs `shouldBe` 1+            T.isInfixOf "rendered command workDir" (errs !! 0) `shouldBe` True+            T.isInfixOf "must not contain '..' segment" (errs !! 0) `shouldBe` True+          Right _ -> expectationFailure "Expected Left"++    it "fails compilation when command has unresolved placeholder" $ do+      withFixture [("data.txt", "content")] $ \baseDir -> do+        let modul =+              Module+                { name = "test",+                  version = Nothing,+                  description = Nothing,+                  vars = [],+                  exports = [],+                  prompts = [],+                  steps = [Step Copy "data.txt" "data.txt" Nothing Nothing],+                  commands = [Command "echo {{missing}}" Nothing Nothing],+                  dependencies = [],+                  removal = Nothing,+                  migrations = []+                }+            vars = Map.empty+        result <- compilePlan baseDir modul vars+        case result of+          Left errs -> do+            length errs `shouldSatisfy` (>= 1)+            T.isInfixOf "missing" (errs !! 0) `shouldBe` True+          Right _ -> expectationFailure "Expected Left"
+ test/Seihou/Engine/PreviewSpec.hs view
@@ -0,0 +1,237 @@+module Seihou.Engine.PreviewSpec (tests) where++import Data.Map.Strict qualified as Map+import Data.Text qualified as T+import Seihou.Core.Types+import Seihou.Engine.Preview+import Test.Hspec+import Test.Tasty+import Test.Tasty.Hspec (testSpec)++tests :: IO TestTree+tests = testSpec "Seihou.Engine.Preview" spec++modName :: ModuleName+modName = ModuleName "test-module"++modName2 :: ModuleName+modName2 = ModuleName "other-module"++-- | A DiffResult with all fields empty.+emptyDiff :: DiffResult+emptyDiff =+  DiffResult+    { new = [],+      modified = [],+      unchanged = [],+      conflicts = [],+      orphaned = []+    }++spec :: Spec+spec = do+  describe "buildPreview" $ do+    it "treats all file ops as FsNew when no DiffResult is provided" $ do+      let ops =+            [ WriteFileOp "README.md" "# Hello" Template,+              WriteFileOp "src/Lib.hs" "module Lib" Template,+              CopyFileOp "templates/LICENSE" "LICENSE"+            ]+          result = buildPreview ops Nothing Map.empty+      length result `shouldBe` 3+      (result !! 0).previewStatus `shouldBe` FsNew+      (result !! 1).previewStatus `shouldBe` FsNew+      (result !! 2).previewStatus `shouldBe` FsNew++    it "classifies a new file as FsNew" $ do+      let ops = [WriteFileOp "README.md" "# Hello" Template]+          diff = emptyDiff {new = [PlannedFile "README.md" modName "# Hello"]}+          result = buildPreview ops (Just diff) Map.empty+      length result `shouldBe` 1+      (head result).previewStatus `shouldBe` FsNew++    it "classifies a modified file as FsModified" $ do+      let ops = [WriteFileOp "README.md" "# Updated" Template]+          diff = emptyDiff {modified = [ModifiedFile "README.md" modName (SHA256 "old") "# Updated"]}+          result = buildPreview ops (Just diff) Map.empty+      length result `shouldBe` 1+      (head result).previewStatus `shouldBe` FsModified++    it "classifies an unchanged file as FsUnchanged" $ do+      let ops = [WriteFileOp "README.md" "# Same" Template]+          diff = emptyDiff {unchanged = ["README.md"]}+          result = buildPreview ops (Just diff) Map.empty+      length result `shouldBe` 1+      (head result).previewStatus `shouldBe` FsUnchanged++    it "classifies a conflicting file as FsConflict" $ do+      let ops = [WriteFileOp "README.md" "# New" Template]+          diff =+            emptyDiff+              { conflicts =+                  [ ConflictFile+                      { path = "README.md",+                        moduleName = modName,+                        manifestHash = SHA256 "man",+                        diskHash = SHA256 "disk",+                        planContent = "# New"+                      }+                  ]+              }+          result = buildPreview ops (Just diff) Map.empty+      length result `shouldBe` 1+      (head result).previewStatus `shouldBe` FsConflict++    it "classifies an orphaned file as FsOrphaned" $ do+      let ops = [WriteFileOp "other.txt" "content" Template]+          diff =+            emptyDiff+              { new = [PlannedFile "other.txt" modName "content"],+                orphaned = [OrphanedFile "old.txt" modName]+              }+          result = buildPreview ops (Just diff) Map.empty+      -- One file preview + one orphan preview+      length result `shouldBe` 2+      let orphan = result !! 1+      case orphan of+        OrphanPreview path mn -> do+          path `shouldBe` "old.txt"+          mn `shouldBe` modName+        _ -> expectationFailure "Expected OrphanPreview"++    it "does not include orphaned files that are produced by an operation" $ do+      let ops = [WriteFileOp "reused.txt" "content" Template]+          diff =+            emptyDiff+              { new = [PlannedFile "reused.txt" modName "content"],+                orphaned = [OrphanedFile "reused.txt" modName2]+              }+          result = buildPreview ops (Just diff) Map.empty+      -- Only the file preview, orphan is suppressed because path matches an operation+      length result `shouldBe` 1+      case head result of+        FilePreview {} -> pure ()+        _ -> expectationFailure "Expected FilePreview"++    it "produces DirPreview for CreateDirOp" $ do+      let ops = [CreateDirOp "src"]+          result = buildPreview ops Nothing Map.empty+      length result `shouldBe` 1+      case head result of+        DirPreview path -> path `shouldBe` "src"+        _ -> expectationFailure "Expected DirPreview"++    it "produces CommandPreview for RunCommandOp" $ do+      let ops = [RunCommandOp "cabal build" Nothing]+          result = buildPreview ops Nothing Map.empty+      length result `shouldBe` 1+      case head result of+        CommandPreview cmd -> cmd `shouldBe` "cabal build"+        _ -> expectationFailure "Expected CommandPreview"++    it "maps PatchFileOp to FilePreview with patch annotation" $ do+      let ops = [PatchFileOp "README.md" "extra content" AppendSection Template modName]+          result = buildPreview ops Nothing Map.empty+      length result `shouldBe` 1+      case head result of+        FilePreview status path annotation mMod -> do+          status `shouldBe` FsNew+          path `shouldBe` "README.md"+          annotation `shouldBe` "patch"+          mMod `shouldBe` Just modName+        _ -> expectationFailure "Expected FilePreview"++    it "maps CopyFileOp to FilePreview with copy annotation" $ do+      let ops = [CopyFileOp "templates/LICENSE" "LICENSE"]+          result = buildPreview ops Nothing Map.empty+      length result `shouldBe` 1+      case head result of+        FilePreview _ path annotation _ -> do+          path `shouldBe` "LICENSE"+          annotation `shouldBe` "copy"+        _ -> expectationFailure "Expected FilePreview"++    it "includes correct strategy annotation for WriteFileOp" $ do+      let ops =+            [ WriteFileOp "a.txt" "" Copy,+              WriteFileOp "b.txt" "" Template,+              WriteFileOp "c.txt" "" DhallText,+              WriteFileOp "d.txt" "" Structured+            ]+          result = buildPreview ops Nothing Map.empty+      map (.previewAnnotation) (filter isFilePreview result)+        `shouldBe` ["copy", "template", "dhall-text", "structured"]++  describe "renderPreviewPlain" $ do+    it "renders empty list as 'No operations' message" $ do+      renderPreviewPlain [] `shouldBe` "No operations to perform.\n"++    it "renders FilePreview lines with status tags" $ do+      let lines' =+            [ FilePreview FsNew "README.md" "template" Nothing,+              FilePreview FsModified "src/Lib.hs" "template" Nothing,+              FilePreview FsUnchanged "LICENSE" "copy" Nothing,+              FilePreview FsConflict "config.yml" "structured" Nothing,+              FilePreview FsOrphaned "old.txt" "template" Nothing+            ]+          rendered = renderPreviewPlain lines'+          renderedLines = T.lines rendered+      length renderedLines `shouldBe` 5+      (renderedLines !! 0) `shouldBe` "    [new]  README.md   (template)"+      (renderedLines !! 1) `shouldBe` "    [modified]  src/Lib.hs  (template)"+      (renderedLines !! 2) `shouldBe` "    [unchanged]  LICENSE     (copy)"+      (renderedLines !! 3) `shouldBe` "    [conflict]  config.yml  (structured)"+      (renderedLines !! 4) `shouldBe` "    [orphaned]  old.txt     (template)"++    it "renders DirPreview, CommandPreview, and OrphanPreview" $ do+      let lines' =+            [ DirPreview "src",+              CommandPreview "cabal build",+              OrphanPreview "gone.txt" modName+            ]+          rendered = renderPreviewPlain lines'+          renderedLines = T.lines rendered+      length renderedLines `shouldBe` 3+      (renderedLines !! 0) `shouldBe` "    mkdir  src"+      (renderedLines !! 1) `shouldBe` "    run    cabal build"+      (renderedLines !! 2) `shouldBe` "    [orphaned]  gone.txt  (orphaned from test-module)"++  describe "formatPlanView" $ do+    it "includes header with module names" $ do+      let preview = [FilePreview FsNew "README.md" "template" (Just modName)]+          diff = emptyDiff {new = [PlannedFile "README.md" modName "# Hello"]}+          rendered = formatPlanView [modName] Map.empty preview diff+      T.isInfixOf "Generation Plan (test-module):" rendered `shouldBe` True++    it "includes header with multiple module names joined by +" $ do+      let preview = []+          diff = emptyDiff+          rendered = formatPlanView [modName, modName2] Map.empty preview diff+      T.isInfixOf "Generation Plan (test-module + other-module):" rendered `shouldBe` True++    it "includes Variables section when variables are present" $ do+      let vars = Map.fromList [(VarName "project.name", VText "hello")]+          preview = []+          diff = emptyDiff+          rendered = formatPlanView [modName] vars preview diff+      T.isInfixOf "Variables:" rendered `shouldBe` True+      T.isInfixOf "project.name" rendered `shouldBe` True+      T.isInfixOf "\"hello\"" rendered `shouldBe` True++    it "omits Variables section when no variables" $ do+      let rendered = formatPlanView [modName] Map.empty [] emptyDiff+      T.isInfixOf "Variables:" rendered `shouldBe` False++    it "includes summary with file and conflict counts" $ do+      let diff =+            emptyDiff+              { new = [PlannedFile "a.txt" modName ""],+                modified = [ModifiedFile "b.txt" modName (SHA256 "old") "new"]+              }+          rendered = formatPlanView [modName] Map.empty [] diff+      T.isInfixOf "2 files to write, 0 conflicts" rendered `shouldBe` True++-- | Helper to test if a PreviewLine is a FilePreview.+isFilePreview :: PreviewLine -> Bool+isFilePreview (FilePreview {}) = True+isFilePreview _ = False
+ test/Seihou/Engine/RemoveSpec.hs view
@@ -0,0 +1,392 @@+module Seihou.Engine.RemoveSpec (tests) where++import Data.Map.Strict qualified as Map+import Data.Set qualified as Set+import Data.Text (Text)+import Data.Time (UTCTime, defaultTimeLocale, parseTimeOrError)+import Effectful+import Seihou.Core.Types+import Seihou.Effect.FilesystemPure (PureFS (..), emptyFS, runFilesystemPure)+import Seihou.Engine.Remove+import Seihou.Manifest.Hash (hashContent)+import Seihou.Manifest.Types (emptyManifest)+import Test.Hspec+import Test.Tasty+import Test.Tasty.Hspec (testSpec)++tests :: IO TestTree+tests = testSpec "Seihou.Engine.Remove" spec++fixedTime :: UTCTime+fixedTime = parseTimeOrError True defaultTimeLocale "%Y-%m-%dT%H:%M:%SZ" "2026-03-01T10:30:00Z"++removeTime :: UTCTime+removeTime = parseTimeOrError True defaultTimeLocale "%Y-%m-%dT%H:%M:%SZ" "2026-03-02T09:00:00Z"++modName :: ModuleName+modName = ModuleName "test-module"++otherMod :: ModuleName+otherMod = ModuleName "other-module"++-- | Helper: create a manifest with one applied module and some files.+mkManifest :: Bool -> [(FilePath, Text)] -> Manifest+mkManifest isRemovable fileContents =+  (emptyManifest fixedTime)+    { modules =+        [ AppliedModule+            { name = modName,+              parentVars = emptyParentVars,+              source = "/path/to/test-module",+              moduleVersion = Nothing,+              appliedAt = fixedTime,+              removal = if isRemovable then Just (Removal [] []) else Nothing+            }+        ],+      files =+        Map.fromList+          [ ( path,+              FileRecord+                { hash = hashContent content,+                  moduleName = modName,+                  strategy = Template,+                  generatedAt = fixedTime+                }+            )+          | (path, content) <- fileContents+          ]+    }++-- | Helper: create a manifest with a specific removal spec.+mkManifestWithRemoval :: Removal -> [(FilePath, Text)] -> Manifest+mkManifestWithRemoval removal fileContents =+  (emptyManifest fixedTime)+    { modules =+        [ AppliedModule+            { name = modName,+              source = "/path/to/test-module",+              moduleVersion = Nothing,+              appliedAt = fixedTime,+              removal = Just removal+            }+        ],+      files =+        Map.fromList+          [ ( path,+              FileRecord+                { hash = hashContent content,+                  moduleName = modName,+                  strategy = Template,+                  generatedAt = fixedTime+                }+            )+          | (path, content) <- fileContents+          ]+    }++-- | Helper: create a PureFS with files.+mkFS :: [(FilePath, Text)] -> PureFS+mkFS fileContents = PureFS (Map.fromList fileContents) Set.empty++-- | Run computeRemovalPlan in the pure filesystem.+runPlan :: PureFS -> Manifest -> ModuleName -> Either RemovalError RemovalPlan+runPlan fs manifest name =+  fst $ runPureEff $ runFilesystemPure fs $ computeRemovalPlan manifest name++-- | Run executeRemoval in the pure filesystem.+runExec :: PureFS -> Manifest -> RemovalPlan -> Set.Set FilePath -> (Manifest, PureFS)+runExec fs manifest plan keepSet =+  let (result, finalFS) =+        runPureEff $+          runFilesystemPure fs $+            executeRemoval manifest plan keepSet removeTime+   in (result, finalFS)++-- | Run buildRemovalOps in the pure filesystem.+runBuildOps :: PureFS -> Manifest -> ModuleName -> Removal -> Either RemovalError ExecutedRemovalPlan+runBuildOps fs manifest name removal =+  fst $ runPureEff $ runFilesystemPure fs $ buildRemovalOps manifest name removal++-- | Run executeRemovalOps in the pure filesystem.+runExecOps :: PureFS -> Manifest -> ExecutedRemovalPlan -> Set.Set FilePath -> (Manifest, PureFS)+runExecOps fs manifest plan keepSet =+  let (result, finalFS) =+        runPureEff $+          runFilesystemPure fs $+            executeRemovalOps manifest plan keepSet removeTime+   in (result, finalFS)++spec :: Spec+spec = do+  describe "computeRemovalPlan" $ do+    it "returns ModuleNotApplied when module is not in manifest" $ do+      let manifest = emptyManifest fixedTime+          result = runPlan emptyFS manifest modName+      result `shouldBe` Left (ModuleNotApplied modName)++    it "returns ModuleNotRemovable when removal is Nothing" $ do+      let manifest = mkManifest False [("README.md", "hello")]+          fs = mkFS [("README.md", "hello")]+          result = runPlan fs manifest modName+      result `shouldBe` Left (ModuleNotRemovable modName)++    it "classifies unchanged files as RemovalSafe" $ do+      let manifest = mkManifest True [("README.md", "hello")]+          fs = mkFS [("README.md", "hello")]+          result = runPlan fs manifest modName+      case result of+        Left err -> expectationFailure ("unexpected error: " <> show err)+        Right plan -> plan.files `shouldBe` [RemovalSafe "README.md"]++    it "classifies user-modified files as RemovalConflict" $ do+      let manifest = mkManifest True [("README.md", "original")]+          fs = mkFS [("README.md", "user changed this")]+          result = runPlan fs manifest modName+      case result of+        Left err -> expectationFailure ("unexpected error: " <> show err)+        Right plan -> plan.files `shouldBe` [RemovalConflict "README.md"]++    it "classifies deleted files as RemovalGone" $ do+      let manifest = mkManifest True [("README.md", "hello")]+          result = runPlan emptyFS manifest modName+      case result of+        Left err -> expectationFailure ("unexpected error: " <> show err)+        Right plan -> plan.files `shouldBe` [RemovalGone "README.md"]++    it "handles mix of safe, conflict, and gone files" $ do+      let manifest = mkManifest True [("a.txt", "aaa"), ("b.txt", "bbb"), ("c.txt", "ccc")]+          fs = mkFS [("a.txt", "aaa"), ("b.txt", "modified")]+          result = runPlan fs manifest modName+      case result of+        Left err -> expectationFailure ("unexpected error: " <> show err)+        Right plan -> do+          length plan.files `shouldBe` 3+          RemovalSafe "a.txt" `elem` plan.files `shouldBe` True+          RemovalConflict "b.txt" `elem` plan.files `shouldBe` True+          RemovalGone "c.txt" `elem` plan.files `shouldBe` True++  describe "executeRemoval" $ do+    it "deletes safe files from the filesystem" $ do+      let manifest = mkManifest True [("README.md", "hello")]+          fs = mkFS [("README.md", "hello")]+          plan = RemovalPlan {targetModule = modName, files = [RemovalSafe "README.md"]}+          (_, finalFS) = runExec fs manifest plan Set.empty+      Map.member "README.md" finalFS.files `shouldBe` False++    it "preserves files in the keep-set" $ do+      let manifest = mkManifest True [("a.txt", "aaa")]+          fs = mkFS [("a.txt", "modified")]+          plan = RemovalPlan {targetModule = modName, files = [RemovalConflict "a.txt"]}+          keepSet = Set.singleton "a.txt"+          (_, finalFS) = runExec fs manifest plan keepSet+      Map.member "a.txt" finalFS.files `shouldBe` True++    it "removes the module from manifest.modules" $ do+      let manifest = mkManifest True [("README.md", "hello")]+          fs = mkFS [("README.md", "hello")]+          plan = RemovalPlan {targetModule = modName, files = [RemovalSafe "README.md"]}+          (updated, _) = runExec fs manifest plan Set.empty+      updated.modules `shouldBe` []++    it "removes module's files from manifest.files" $ do+      let manifest = mkManifest True [("a.txt", "aaa"), ("b.txt", "bbb")]+          fs = mkFS [("a.txt", "aaa"), ("b.txt", "bbb")]+          plan = RemovalPlan {targetModule = modName, files = [RemovalSafe "a.txt", RemovalSafe "b.txt"]}+          (updated, _) = runExec fs manifest plan Set.empty+      Map.null updated.files `shouldBe` True++    it "preserves files from other modules in manifest" $ do+      let base = mkManifest True [("mine.txt", "mine")]+          otherRec = FileRecord (hashContent "other") otherMod Template fixedTime+          manifest =+            Manifest+              { version = base.version,+                genAt = base.genAt,+                modules = base.modules,+                vars = base.vars,+                files = Map.insert "other.txt" otherRec base.files+              }+          fs = mkFS [("mine.txt", "mine"), ("other.txt", "other")]+          plan = RemovalPlan {targetModule = modName, files = [RemovalSafe "mine.txt"]}+          (updated, _) = runExec fs manifest plan Set.empty+      Map.member "other.txt" updated.files `shouldBe` True+      Map.member "mine.txt" updated.files `shouldBe` False++    it "updates genAt timestamp in manifest" $ do+      let manifest = mkManifest True [("a.txt", "aaa")]+          fs = mkFS [("a.txt", "aaa")]+          plan = RemovalPlan {targetModule = modName, files = [RemovalSafe "a.txt"]}+          (updated, _) = runExec fs manifest plan Set.empty+      updated.genAt `shouldBe` removeTime++    it "full round-trip: manifest returns to clean state after removal" $ do+      let manifest = mkManifest True [("a.txt", "aaa"), ("b.txt", "bbb")]+          fs = mkFS [("a.txt", "aaa"), ("b.txt", "bbb")]+          plan = RemovalPlan {targetModule = modName, files = [RemovalSafe "a.txt", RemovalSafe "b.txt"]}+          (updated, finalFS) = runExec fs manifest plan Set.empty+      updated.modules `shouldBe` []+      Map.null updated.files `shouldBe` True+      Map.member "a.txt" finalFS.files `shouldBe` False+      Map.member "b.txt" finalFS.files `shouldBe` False++  describe "buildRemovalOps" $ do+    it "returns ModuleNotApplied when module is not in manifest" $ do+      let manifest = emptyManifest fixedTime+          removal = Removal [] []+          result = runBuildOps emptyFS manifest modName removal+      result `shouldBe` Left (ModuleNotApplied modName)++    it "builds DeleteFileOp with RFSafe for unchanged files" $ do+      let removal = Removal [RemovalStep RemoveFileAction "README.md" Nothing] []+          manifest = mkManifestWithRemoval removal [("README.md", "hello")]+          fs = mkFS [("README.md", "hello")]+          result = runBuildOps fs manifest modName removal+      case result of+        Left err -> expectationFailure ("unexpected error: " <> show err)+        Right plan -> plan.ops `shouldBe` [DeleteFileOp "README.md" RFSafe]++    it "builds DeleteFileOp with RFConflict for modified files" $ do+      let removal = Removal [RemovalStep RemoveFileAction "README.md" Nothing] []+          manifest = mkManifestWithRemoval removal [("README.md", "original")]+          fs = mkFS [("README.md", "user changed this")]+          result = runBuildOps fs manifest modName removal+      case result of+        Left err -> expectationFailure ("unexpected error: " <> show err)+        Right plan -> plan.ops `shouldBe` [DeleteFileOp "README.md" RFConflict]++    it "builds DeleteFileOp with RFGone for already-deleted files" $ do+      let removal = Removal [RemovalStep RemoveFileAction "README.md" Nothing] []+          manifest = mkManifestWithRemoval removal [("README.md", "hello")]+          result = runBuildOps emptyFS manifest modName removal+      case result of+        Left err -> expectationFailure ("unexpected error: " <> show err)+        Right plan -> plan.ops `shouldBe` [DeleteFileOp "README.md" RFGone]++    it "builds StripSectionOp for remove-section steps" $ do+      let removal = Removal [RemovalStep RemoveSectionAction ".gitignore" Nothing] []+          manifest = mkManifestWithRemoval removal [(".gitignore", "content")]+          fs = mkFS [(".gitignore", "content")]+          result = runBuildOps fs manifest modName removal+      case result of+        Left err -> expectationFailure ("unexpected error: " <> show err)+        Right plan -> plan.ops `shouldBe` [StripSectionOp ".gitignore"]++    it "builds RemovalCommandOp for removal commands" $ do+      let removal = Removal [] [Command "cabal clean" Nothing Nothing]+          manifest = mkManifestWithRemoval removal []+          result = runBuildOps emptyFS manifest modName removal+      case result of+        Left err -> expectationFailure ("unexpected error: " <> show err)+        Right plan -> plan.ops `shouldBe` [RemovalCommandOp "cabal clean" Nothing]++    it "rejects a removal step destination with a parent directory segment" $ do+      let removal = Removal [RemovalStep RemoveFileAction "../outside" Nothing] []+          manifest = mkManifestWithRemoval removal []+          fs = mkFS [("../outside", "do not delete")]+          result = runBuildOps fs manifest modName removal+      result+        `shouldBe` Left+          ( RemovalUnsafePath+              "remove-file destination"+              "../outside"+              "path must not contain '..' segment: ../outside"+          )+      Map.member "../outside" fs.files `shouldBe` True++    it "rejects a removal command workDir with a parent directory segment" $ do+      let removal = Removal [] [Command "echo unsafe" (Just "../outside") Nothing]+          manifest = mkManifestWithRemoval removal []+          result = runBuildOps emptyFS manifest modName removal+      result+        `shouldBe` Left+          ( RemovalUnsafePath+              "remove-command workDir"+              "../outside"+              "path must not contain '..' segment: ../outside"+          )++    it "combines steps and commands in order" $ do+      let removal =+            Removal+              [RemovalStep RemoveFileAction "a.txt" Nothing, RemovalStep RemoveSectionAction ".gitignore" Nothing]+              [Command "echo done" Nothing Nothing]+          manifest = mkManifestWithRemoval removal [("a.txt", "aaa")]+          fs = mkFS [("a.txt", "aaa"), (".gitignore", "stuff")]+          result = runBuildOps fs manifest modName removal+      case result of+        Left err -> expectationFailure ("unexpected error: " <> show err)+        Right plan -> do+          length plan.ops `shouldBe` 3+          case plan.ops of+            [DeleteFileOp _ _, StripSectionOp _, RemovalCommandOp _ _] -> pure ()+            other -> expectationFailure ("unexpected ops: " <> show other)++  describe "executeRemovalOps" $ do+    it "deletes files with DeleteFileOp" $ do+      let removal = Removal [RemovalStep RemoveFileAction "README.md" Nothing] []+          manifest = mkManifestWithRemoval removal [("README.md", "hello")]+          fs = mkFS [("README.md", "hello")]+          plan = ExecutedRemovalPlan modName [DeleteFileOp "README.md" RFSafe]+          (_, finalFS) = runExecOps fs manifest plan Set.empty+      Map.member "README.md" finalFS.files `shouldBe` False++    it "preserves files in keep-set for DeleteFileOp" $ do+      let removal = Removal [RemovalStep RemoveFileAction "a.txt" Nothing] []+          manifest = mkManifestWithRemoval removal [("a.txt", "aaa")]+          fs = mkFS [("a.txt", "modified")]+          plan = ExecutedRemovalPlan modName [DeleteFileOp "a.txt" RFConflict]+          keepSet = Set.singleton "a.txt"+          (_, finalFS) = runExecOps fs manifest plan keepSet+      Map.member "a.txt" finalFS.files `shouldBe` True++    it "skips gone files" $ do+      let manifest = mkManifest True [("a.txt", "aaa")]+          plan = ExecutedRemovalPlan modName [DeleteFileOp "a.txt" RFGone]+          (updated, _) = runExecOps emptyFS manifest plan Set.empty+      updated.modules `shouldBe` []++    it "strips section from file with StripSectionOp" $ do+      let content = "before\n# --- seihou:test-module ---\nmodule content\n# --- /seihou:test-module ---\nafter\n"+          manifest = mkManifest True [(".gitignore", content)]+          fs = mkFS [(".gitignore", content)]+          plan = ExecutedRemovalPlan modName [StripSectionOp ".gitignore"]+          (_, finalFS) = runExecOps fs manifest plan Set.empty+      case Map.lookup ".gitignore" finalFS.files of+        Nothing -> expectationFailure ".gitignore should still exist"+        Just result -> do+          result `shouldSatisfy` \t ->+            "before" `elem` lines (show t) || not ("seihou:test-module" `elem` lines (show t))++    it "leaves file unchanged when no section markers found" $ do+      let content = "no markers here\n"+          manifest = mkManifest True [("file.txt", content)]+          fs = mkFS [("file.txt", content)]+          plan = ExecutedRemovalPlan modName [StripSectionOp "file.txt"]+          (_, finalFS) = runExecOps fs manifest plan Set.empty+      Map.lookup "file.txt" finalFS.files `shouldBe` Just content++    it "removes module from manifest after all steps" $ do+      let removal = Removal [RemovalStep RemoveFileAction "a.txt" Nothing] []+          manifest = mkManifestWithRemoval removal [("a.txt", "aaa")]+          fs = mkFS [("a.txt", "aaa")]+          plan = ExecutedRemovalPlan modName [DeleteFileOp "a.txt" RFSafe]+          (updated, _) = runExecOps fs manifest plan Set.empty+      updated.modules `shouldBe` []+      Map.null updated.files `shouldBe` True++    it "preserves other modules' files in manifest" $ do+      let base = mkManifest True [("mine.txt", "mine")]+          otherRec = FileRecord (hashContent "other") otherMod Template fixedTime+          manifest =+            Manifest+              { version = base.version,+                genAt = base.genAt,+                modules = base.modules,+                vars = base.vars,+                files = Map.insert "other.txt" otherRec base.files+              }+          fs = mkFS [("mine.txt", "mine"), ("other.txt", "other")]+          plan = ExecutedRemovalPlan modName [DeleteFileOp "mine.txt" RFSafe]+          (updated, _) = runExecOps fs manifest plan Set.empty+      Map.member "other.txt" updated.files `shouldBe` True+      Map.member "mine.txt" updated.files `shouldBe` False
+ test/Seihou/Engine/SectionSpec.hs view
@@ -0,0 +1,171 @@+module Seihou.Engine.SectionSpec (tests) where++import Data.Text qualified as T+import Seihou.Core.Types+import Seihou.Engine.Section+import Test.Hspec+import Test.Tasty+import Test.Tasty.Hspec (testSpec)++tests :: IO TestTree+tests = testSpec "Seihou.Engine.Section" spec++modName :: ModuleName+modName = ModuleName "nix-flake"++marker :: SectionMarker+marker = SectionMarker {sectionPrefix = "#", sectionModule = modName}++spec :: Spec+spec = do+  describe "renderSectionOpen" $ do+    it "produces correct format with # prefix" $ do+      renderSectionOpen marker `shouldBe` "# --- seihou:nix-flake ---\n"++    it "produces correct format with -- prefix" $ do+      let hsMarker = marker {sectionPrefix = "--"}+      renderSectionOpen hsMarker `shouldBe` "-- --- seihou:nix-flake ---\n"++  describe "renderSectionClose" $ do+    it "produces correct format with # prefix" $ do+      renderSectionClose marker `shouldBe` "# --- /seihou:nix-flake ---\n"++    it "produces correct format with -- prefix" $ do+      let hsMarker = marker {sectionPrefix = "--"}+      renderSectionClose hsMarker `shouldBe` "-- --- /seihou:nix-flake ---\n"++  describe "wrapInSection" $ do+    it "wraps content with open and close markers" $ do+      wrapInSection marker "extra config\n"+        `shouldBe` "# --- seihou:nix-flake ---\nextra config\n# --- /seihou:nix-flake ---\n"++    it "adds trailing newline to content if missing" $ do+      wrapInSection marker "no trailing newline"+        `shouldBe` "# --- seihou:nix-flake ---\nno trailing newline\n# --- /seihou:nix-flake ---\n"++    it "handles empty content" $ do+      wrapInSection marker ""+        `shouldBe` "# --- seihou:nix-flake ---\n# --- /seihou:nix-flake ---\n"++  describe "applyTextPatch" $ do+    it "AppendFile appends content after existing" $ do+      let result = applyTextPatch AppendFile modName "#" "line1\n" "line2\n"+      result `shouldBe` Right "line1\nline2\n"++    it "AppendFile ensures newline between existing and new" $ do+      let result = applyTextPatch AppendFile modName "#" "line1" "line2\n"+      result `shouldBe` Right "line1\nline2\n"++    it "PrependFile prepends content before existing" $ do+      let result = applyTextPatch PrependFile modName "#" "line2\n" "line1\n"+      result `shouldBe` Right "line1\nline2\n"++    it "PrependFile ensures newline between new and existing" $ do+      let result = applyTextPatch PrependFile modName "#" "line2\n" "line1"+      result `shouldBe` Right "line1\nline2\n"++    it "AppendSection appends wrapped section" $ do+      let result = applyTextPatch AppendSection modName "#" "base content\n" "extra\n"+      result+        `shouldBe` Right+          "base content\n# --- seihou:nix-flake ---\nextra\n# --- /seihou:nix-flake ---\n"++    it "AppendSection uses configured comment prefix" $ do+      let result = applyTextPatch AppendSection modName "--" "base\n" "extra\n"+      result+        `shouldBe` Right+          "base\n-- --- seihou:nix-flake ---\nextra\n-- --- /seihou:nix-flake ---\n"++    it "AppendSection works with empty existing content" $ do+      let result = applyTextPatch AppendSection modName "#" "" "new section\n"+      result+        `shouldBe` Right+          "# --- seihou:nix-flake ---\nnew section\n# --- /seihou:nix-flake ---\n"++    it "AppendFile with empty existing content" $ do+      let result = applyTextPatch AppendFile modName "#" "" "new content\n"+      result `shouldBe` Right "new content\n"++    it "PrependFile with empty existing content" $ do+      let result = applyTextPatch PrependFile modName "#" "" "new content\n"+      result `shouldBe` Right "new content\n"++    it "AppendLineIfAbsent appends only missing lines" $ do+      let result = applyTextPatch AppendLineIfAbsent modName "#" "line1\nline2\n" "line2\nline3\n"+      result `shouldBe` Right "line1\nline2\nline3\n"++    it "AppendLineIfAbsent is idempotent when all lines present" $ do+      let existing = ".claude/\nnode_modules/\n"+          result = applyTextPatch AppendLineIfAbsent modName "#" existing ".claude/\n"+      result `shouldBe` Right existing++    it "AppendLineIfAbsent with empty existing content" $ do+      let result = applyTextPatch AppendLineIfAbsent modName "#" "" ".claude/\n"+      result `shouldBe` Right ".claude/\n"++    it "AppendLineIfAbsent ignores trailing whitespace differences" $ do+      let result = applyTextPatch AppendLineIfAbsent modName "#" "line1  \n" "line1\n"+      result `shouldBe` Right "line1  \n"++    it "AppendLineIfAbsent handles multiple new lines, some present" $ do+      let result =+            applyTextPatch+              AppendLineIfAbsent+              modName+              "#"+              "*.log\n.env\n"+              "*.log\n.claude/\n.env\ndist/\n"+      result `shouldBe` Right "*.log\n.env\n.claude/\ndist/\n"++  describe "removeSection" $ do+    it "removes a section between markers" $ do+      let content = "before\n# --- seihou:nix-flake ---\nmodule content\n# --- /seihou:nix-flake ---\nafter\n"+          result = removeSection modName "#" content+      result `shouldBe` "before\nafter\n"++    it "leaves content outside markers intact" $ do+      let content = "line1\nline2\n# --- seihou:nix-flake ---\nstuff\n# --- /seihou:nix-flake ---\nline3\nline4\n"+          result = removeSection modName "#" content+      result `shouldBe` "line1\nline2\nline3\nline4\n"++    it "returns content unchanged when no markers found" $ do+      let content = "no markers here\njust text\n"+          result = removeSection modName "#" content+      result `shouldBe` content++    it "only removes the target module's section" $ do+      let otherMod' = ModuleName "other-module"+          content =+            "start\n"+              <> "# --- seihou:nix-flake ---\nflake stuff\n# --- /seihou:nix-flake ---\n"+              <> "# --- seihou:other-module ---\nother stuff\n# --- /seihou:other-module ---\n"+              <> "end\n"+      -- Remove nix-flake: should keep other-module+      let result = removeSection modName "#" content+      T.isInfixOf "seihou:nix-flake" result `shouldBe` False+      T.isInfixOf "seihou:other-module" result `shouldBe` True+      -- Remove other-module: should keep nix-flake+      let result2 = removeSection otherMod' "#" content+      T.isInfixOf "seihou:nix-flake" result2 `shouldBe` True+      T.isInfixOf "seihou:other-module" result2 `shouldBe` False++    it "cleans up double blank lines after removal" $ do+      let content = "before\n\n# --- seihou:nix-flake ---\nstuff\n# --- /seihou:nix-flake ---\n\nafter\n"+          result = removeSection modName "#" content+      -- Should not have triple+ blank lines+      T.isInfixOf "\n\n\n" result `shouldBe` False++    it "handles section at beginning of file" $ do+      let content = "# --- seihou:nix-flake ---\nstuff\n# --- /seihou:nix-flake ---\nafter\n"+          result = removeSection modName "#" content+      result `shouldBe` "after\n"++    it "handles section at end of file" $ do+      let content = "before\n# --- seihou:nix-flake ---\nstuff\n# --- /seihou:nix-flake ---\n"+          result = removeSection modName "#" content+      result `shouldBe` "before\n"++    it "works with -- comment prefix" $ do+      let content = "before\n-- --- seihou:nix-flake ---\nstuff\n-- --- /seihou:nix-flake ---\nafter\n"+          result = removeSection modName "--" content+      result `shouldBe` "before\nafter\n"
+ test/Seihou/Engine/TemplateSpec.hs view
@@ -0,0 +1,419 @@+module Seihou.Engine.TemplateSpec (tests) where++import Data.Map.Strict qualified as Map+import Seihou.Core.Types+import Seihou.Engine.Template+import Test.Hspec+import Test.Tasty+import Test.Tasty.Hspec (testSpec)++tests :: IO TestTree+tests = testSpec "Seihou.Engine.Template" spec++spec :: Spec+spec = do+  describe "valueToText" $ do+    it "converts VText" $ do+      valueToText (VText "hello") `shouldBe` "hello"++    it "converts VBool True" $ do+      valueToText (VBool True) `shouldBe` "true"++    it "converts VBool False" $ do+      valueToText (VBool False) `shouldBe` "false"++    it "converts VInt" $ do+      valueToText (VInt 42) `shouldBe` "42"++    it "converts VList" $ do+      valueToText (VList [VText "a", VText "b", VText "c"]) `shouldBe` "a,b,c"++  describe "renderTemplate" $ do+    it "substitutes a simple placeholder" $ do+      let vars = Map.fromList [("name", VText "world")]+      renderTemplate "Hello, {{name}}!" vars `shouldBe` Right "Hello, world!"++    it "substitutes multiple placeholders on one line" $ do+      let vars = Map.fromList [("first", VText "Jane"), ("last", VText "Doe")]+      renderTemplate "Name: {{first}} {{last}}" vars+        `shouldBe` Right "Name: Jane Doe"++    it "substitutes placeholders across multiple lines" $ do+      let vars = Map.fromList [("project.name", VText "my-app"), ("project.version", VText "0.1.0.0")]+      renderTemplate "# {{project.name}}\nVersion: {{project.version}}" vars+        `shouldBe` Right "# my-app\nVersion: 0.1.0.0"++    it "handles the README fixture pattern" $ do+      let vars = Map.fromList [("project.name", VText "my-app"), ("project.version", VText "0.1.0.0")]+      renderTemplate "# {{project.name}}\n\nVersion: {{project.version}}\n" vars+        `shouldBe` Right "# my-app\n\nVersion: 0.1.0.0\n"++    it "passes through text with no placeholders" $ do+      let vars = Map.empty+      renderTemplate "No placeholders here." vars+        `shouldBe` Right "No placeholders here."++    it "handles empty template" $ do+      let vars = Map.empty+      renderTemplate "" vars `shouldBe` Right ""++    it "handles escape sequence" $ do+      let vars = Map.empty+      renderTemplate "Use \\{{var}} for placeholders" vars+        `shouldBe` Right "Use {{var}} for placeholders"++    it "handles escape sequence with real placeholder" $ do+      let vars = Map.fromList [("name", VText "world")]+      renderTemplate "Literal \\{{not.a.var}} and {{name}}" vars+        `shouldBe` Right "Literal {{not.a.var}} and world"++    it "coerces VBool to text in placeholder" $ do+      let vars = Map.fromList [("enabled", VBool True)]+      renderTemplate "Enabled: {{enabled}}" vars+        `shouldBe` Right "Enabled: true"++    it "coerces VInt to text in placeholder" $ do+      let vars = Map.fromList [("count", VInt 42)]+      renderTemplate "Count: {{count}}" vars+        `shouldBe` Right "Count: 42"++    it "coerces VList to text in placeholder" $ do+      let vars = Map.fromList [("items", VList [VText "a", VText "b"])]+      renderTemplate "Items: {{items}}" vars+        `shouldBe` Right "Items: a,b"++    it "reports unresolved placeholder with correct line number" $ do+      let vars = Map.empty+      case renderTemplate "line one\n{{missing}}\nline three" vars of+        Left errs -> do+          length errs `shouldBe` 1+          case errs of+            (UnresolvedPlaceholder name lineNum : _) -> do+              name `shouldBe` "missing"+              lineNum `shouldBe` 2+            other -> expectationFailure ("Unexpected error: " <> show other)+        Right _ -> expectationFailure "Expected Left"++    it "reports multiple unresolved placeholders" $ do+      let vars = Map.empty+      case renderTemplate "{{a}}\n{{b}}" vars of+        Left errs -> length errs `shouldBe` 2+        Right _ -> expectationFailure "Expected Left"++    it "strips whitespace around placeholder name" $ do+      let vars = Map.fromList [("name", VText "world")]+      renderTemplate "{{ name }}" vars `shouldBe` Right "world"++  describe "renderCommand" $ do+    it "substitutes variables in a command string" $ do+      let vars = Map.fromList [("project.name", VText "my-app")]+      renderCommand "echo {{project.name}}" vars+        `shouldBe` Right "echo my-app"++    it "substitutes multiple placeholders" $ do+      let vars = Map.fromList [("name", VText "app"), ("ver", VText "1.0")]+      renderCommand "echo {{name}}-{{ver}}" vars+        `shouldBe` Right "echo app-1.0"++    it "handles escape sequence" $ do+      let vars = Map.empty+      renderCommand "echo \\{{literal}}" vars+        `shouldBe` Right "echo {{literal}}"++    it "reports unresolved placeholder" $ do+      let vars = Map.empty+      case renderCommand "echo {{missing}}" vars of+        Left errs -> length errs `shouldBe` 1+        Right _ -> expectationFailure "Expected Left"++  describe "renderDestPath" $ do+    it "expands placeholder in destination path" $ do+      let vars = Map.fromList [("project.name", VText "my-app")]+      renderDestPath "{{project.name}}.cabal" vars+        `shouldBe` Right "my-app.cabal"++    it "handles path with subdirectory and placeholder" $ do+      let vars = Map.fromList [("project.name", VText "my-app")]+      renderDestPath "src/{{project.name}}/Main.hs" vars+        `shouldBe` Right "src/my-app/Main.hs"++    it "passes through path with no placeholders" $ do+      let vars = Map.empty+      renderDestPath "src/Lib.hs" vars `shouldBe` Right "src/Lib.hs"++  describe "renderTemplateText" $ do+    it "behaves like renderTemplate on templates with no blocks" $ do+      let vars = Map.fromList [("project.name", VText "my-app")]+          tpl = "# {{project.name}}\nVersion: 0.1.0.0\n"+      renderTemplateText tpl vars+        `shouldBe` renderTemplate tpl vars++    it "selects the then-branch when the if expression is true" $ do+      let vars = Map.fromList [("x", VBool True)]+      renderTemplateText "{{#if Eq x true}}A{{/if}}" vars+        `shouldBe` Right "A"++    it "excludes the then-branch when the if expression is false" $ do+      let vars = Map.fromList [("x", VBool False)]+      renderTemplateText "{{#if Eq x true}}A{{/if}}" vars+        `shouldBe` Right ""++    it "selects the then-branch of an if/else when the variable is set" $ do+      let vars = Map.fromList [("foo", VText "bar")]+      renderTemplateText "{{#if IsSet foo}}yes{{#else}}no{{/if}}" vars+        `shouldBe` Right "yes"++    it "selects the else-branch of an if/else when the variable is unset" $ do+      let vars = Map.empty+      renderTemplateText "{{#if IsSet foo}}yes{{#else}}no{{/if}}" vars+        `shouldBe` Right "no"++    it "handles two-level nesting with both branches taken" $ do+      let vars = Map.fromList [("a", VBool True), ("b", VBool True)]+      renderTemplateText+        "{{#if Eq a true}}outer{{#if Eq b true}}inner{{/if}}outer2{{/if}}"+        vars+        `shouldBe` Right "outerinnerouter2"++    it "handles three-level nesting" $ do+      let vars = Map.fromList [("a", VBool True), ("b", VBool True), ("c", VBool True)]+      renderTemplateText+        "{{#if Eq a true}}{{#if Eq b true}}{{#if Eq c true}}deep{{/if}}{{/if}}{{/if}}"+        vars+        `shouldBe` Right "deep"++    it "reports UnterminatedIf with the opener's source line" $ do+      let tpl = "line one\nline two\n{{#if Eq x true}}never closed\nline four\n"+          vars = Map.fromList [("x", VBool True)]+      case renderTemplateText tpl vars of+        Right _ -> expectationFailure "expected UnterminatedIf"+        Left [UnterminatedIf lineNum] -> lineNum `shouldBe` 3+        Left other -> expectationFailure ("expected [UnterminatedIf 3], got " <> show other)++    it "reports orphan {{/if}} at top level" $ do+      let tpl = "a\nb\n{{/if}}\n"+          vars = Map.empty+      case renderTemplateText tpl vars of+        Right _ -> expectationFailure "expected OrphanBlockToken"+        Left [OrphanBlockToken tok lineNum] -> do+          tok `shouldBe` "{{/if}}"+          lineNum `shouldBe` 3+        Left other ->+          expectationFailure ("expected [OrphanBlockToken \"{{/if}}\" 3], got " <> show other)++    it "reports orphan {{#else}} at top level" $ do+      let tpl = "a\n{{#else}}\n"+          vars = Map.empty+      case renderTemplateText tpl vars of+        Right _ -> expectationFailure "expected OrphanBlockToken"+        Left [OrphanBlockToken tok lineNum] -> do+          tok `shouldBe` "{{#else}}"+          lineNum `shouldBe` 2+        Left other ->+          expectationFailure ("expected [OrphanBlockToken \"{{#else}}\" 2], got " <> show other)++    it "reports MalformedIfExpression with the opener line and parser error" $ do+      let tpl = "ok\n{{#if &&garbage}}body{{/if}}"+          vars = Map.empty+      case renderTemplateText tpl vars of+        Right _ -> expectationFailure "expected MalformedIfExpression"+        Left [MalformedIfExpression rawExpr lineNum _parserErr] -> do+          rawExpr `shouldBe` "&&garbage"+          lineNum `shouldBe` 2+        Left other ->+          expectationFailure ("expected [MalformedIfExpression …], got " <> show other)++    it "substitutes {{var}} inside the taken branch and surfaces unresolved errors" $ do+      let vars = Map.fromList [("gate", VBool True)]+      case renderTemplateText "{{#if Eq gate true}}hello {{name}}{{/if}}" vars of+        Right _ -> expectationFailure "expected UnresolvedPlaceholder in taken branch"+        Left [UnresolvedPlaceholder (VarName nm) _] -> nm `shouldBe` "name"+        Left other -> expectationFailure ("unexpected errors: " <> show other)++    it "discards untaken branches so their {{var}} errors do not surface" $ do+      let vars = Map.fromList [("gate", VBool False)]+      renderTemplateText "before {{#if Eq gate true}}hello {{missing}}{{/if}}after" vars+        `shouldBe` Right "before after"++    it "evaluates && combinator: both true takes the branch" $ do+      let vars = Map.fromList [("a", VBool True), ("b", VBool True)]+      renderTemplateText "{{#if Eq a true && Eq b true}}Y{{#else}}N{{/if}}" vars+        `shouldBe` Right "Y"++    it "evaluates && combinator: one false drops the branch" $ do+      let vars = Map.fromList [("a", VBool True), ("b", VBool False)]+      renderTemplateText "{{#if Eq a true && Eq b true}}Y{{#else}}N{{/if}}" vars+        `shouldBe` Right "N"++    it "evaluates || combinator: either true takes the branch" $ do+      let vars = Map.fromList [("a", VBool False), ("b", VBool True)]+      renderTemplateText "{{#if Eq a true || Eq b true}}Y{{#else}}N{{/if}}" vars+        `shouldBe` Right "Y"++    it "evaluates ! combinator: negation flips the branch" $ do+      let vars = Map.fromList [("a", VBool False)]+      renderTemplateText "{{#if !Eq a true}}Y{{#else}}N{{/if}}" vars+        `shouldBe` Right "Y"++    it "evaluates a parenthesised expression honouring precedence" $ do+      -- (A || B) && !C — with A=false, B=true, C=false → (true) && true = true+      let vars =+            Map.fromList+              [ ("a", VBool False),+                ("b", VBool True),+                ("c", VBool False)+              ]+      renderTemplateText+        "{{#if (Eq a true || Eq b true) && !Eq c true}}Y{{#else}}N{{/if}}"+        vars+        `shouldBe` Right "Y"++    it "matches outer {{#else}} past a nested {{#else}} inside the then-branch" $ do+      -- The outer if's else is "e"; the inner if (B) has its own else "b2".+      -- splitBranches must skip the inner {{#else}} (it's at depth 1) and+      -- only mark the outer {{#else}} (at depth 0).+      let mkVars a b =+            Map.fromList [("a", VBool a), ("b", VBool b)]+      renderTemplateText+        "{{#if Eq a true}}a1{{#if Eq b true}}b1{{#else}}b2{{/if}}a2{{#else}}e{{/if}}"+        (mkVars True True)+        `shouldBe` Right "a1b1a2"+      renderTemplateText+        "{{#if Eq a true}}a1{{#if Eq b true}}b1{{#else}}b2{{/if}}a2{{#else}}e{{/if}}"+        (mkVars True False)+        `shouldBe` Right "a1b2a2"+      renderTemplateText+        "{{#if Eq a true}}a1{{#if Eq b true}}b1{{#else}}b2{{/if}}a2{{#else}}e{{/if}}"+        (mkVars False True)+        `shouldBe` Right "e"++    it "surfaces an UnterminatedIf from a nested block inside the taken branch" $ do+      -- Outer if takes the then-branch; the inner {{#if B}} has no closing+      -- token before the outer {{/if}}, so splitBranches consumes the outer+      -- {{/if}} as the inner's match and reports the outer opener as+      -- unterminated. The precise error is UnterminatedIf; line is the+      -- opener that actually ran out of closers.+      let vars = Map.fromList [("a", VBool True), ("b", VBool True)]+          tpl = "{{#if Eq a true}}outer{{#if Eq b true}}inner{{/if}}"+      case renderTemplateText tpl vars of+        Right r -> expectationFailure ("expected UnterminatedIf, got " <> show r)+        Left [UnterminatedIf _] -> pure ()+        Left other ->+          expectationFailure ("expected [UnterminatedIf _], got " <> show other)++    it "reports UnterminatedIf on the opener line for a long preamble" $ do+      -- Preamble of ten lines; opener on line 11; no {{/if}} at all.+      let preamble = mconcat (replicate 10 "line\n")+          tpl = preamble <> "{{#if Eq x true}}body\nmore body\n"+          vars = Map.fromList [("x", VBool True)]+      case renderTemplateText tpl vars of+        Right _ -> expectationFailure "expected UnterminatedIf"+        Left [UnterminatedIf lineNum] -> lineNum `shouldBe` 11+        Left other -> expectationFailure ("expected [UnterminatedIf 11], got " <> show other)++    it "handles an empty then-branch" $ do+      let vars = Map.fromList [("x", VBool True)]+      renderTemplateText "a{{#if Eq x true}}{{/if}}b" vars+        `shouldBe` Right "ab"++    it "handles an if/else with both branches empty" $ do+      let vars = Map.fromList [("x", VBool False)]+      renderTemplateText "a{{#if Eq x true}}{{#else}}{{/if}}b" vars+        `shouldBe` Right "ab"++    it "handles multiple top-level blocks back-to-back" $ do+      let vars = Map.fromList [("a", VBool True), ("b", VBool False)]+      renderTemplateText+        "{{#if Eq a true}}A{{/if}}-{{#if Eq b true}}B{{/if}}-{{#if Eq a true}}A2{{/if}}"+        vars+        `shouldBe` Right "A--A2"++    it "interleaves {{var}} and {{#if}} on the same line" $ do+      let vars =+            Map.fromList+              [ ("flag", VBool True),+                ("name", VText "world")+              ]+      renderTemplateText+        "pre {{name}} {{#if Eq flag true}}mid-{{name}}-mid{{/if}} post"+        vars+        `shouldBe` Right "pre world mid-world-mid post"++    describe "standalone-block whitespace trim" $ do+      it "absorbs surrounding indentation and the trailing newline when opener is on its own line" $ do+        let vars = Map.fromList [("flag", VBool True)]+            tpl = "prev\n  {{#if Eq flag true}}\n  body\n  {{/if}}\nnext\n"+        renderTemplateText tpl vars `shouldBe` Right "prev\n  body\nnext\n"++      it "absorbs the whole block's lines when the condition is false" $ do+        let vars = Map.fromList [("flag", VBool False)]+            tpl = "prev\n  {{#if Eq flag true}}\n  body\n  {{/if}}\nnext\n"+        renderTemplateText tpl vars `shouldBe` Right "prev\nnext\n"++      it "leaves a compact tag surrounded by content untouched" $ do+        -- Opener and closer are not standalone: both share a line+        -- with template content. No trim should apply.+        let vars = Map.fromList [("x", VBool True)]+        renderTemplateText "a{{#if Eq x true}}b{{/if}}c" vars+          `shouldBe` Right "abc"++      it "treats a tag with leading/trailing whitespace on its line as standalone" $ do+        let vars = Map.fromList [("flag", VBool True)]+            -- Tab + {{#if}} + trailing spaces + newline, all standalone.+            tpl = "prev\n\t{{#if Eq flag true}}   \nbody\n\t{{/if}}   \nnext"+        renderTemplateText tpl vars `shouldBe` Right "prev\nbody\nnext"++      it "handles standalone if/else with mixed branches" $ do+        let tpl =+              "outer\n\+              \{{#if Eq x true}}\n\+              \then-branch\n\+              \{{#else}}\n\+              \else-branch\n\+              \{{/if}}\n\+              \tail\n"+        renderTemplateText tpl (Map.fromList [("x", VBool True)])+          `shouldBe` Right "outer\nthen-branch\ntail\n"+        renderTemplateText tpl (Map.fromList [("x", VBool False)])+          `shouldBe` Right "outer\nelse-branch\ntail\n"++      it "preserves indentation of body lines when tags are standalone" $ do+        let vars = Map.fromList [("flag", VBool True)]+            tpl =+              "foo = [\n\+              \  a\n\+              \  {{#if Eq flag true}}\n\+              \  b\n\+              \  {{/if}}\n\+              \  c\n\+              \];\n"+        renderTemplateText tpl vars+          `shouldBe` Right "foo = [\n  a\n  b\n  c\n];\n"++      it "treats a standalone tag at end of template (no trailing newline) as standalone" $ do+        let vars = Map.fromList [("flag", VBool True)]+            tpl = "prev\n  {{#if Eq flag true}}\n  body\n  {{/if}}"+        renderTemplateText tpl vars `shouldBe` Right "prev\n  body\n"++      it "preserves an explicit blank line inside a standalone block" $ do+        -- A blank line immediately after {{#if}} is NOT consumed by+        -- the opener's trim (only ONE newline is absorbed). This lets+        -- template authors emit an intentional blank separator.+        let vars = Map.fromList [("x", VBool True)]+            tpl = "alpha\n{{#if Eq x true}}\n\nbeta\n{{/if}}\ngamma\n"+        renderTemplateText tpl vars `shouldBe` Right "alpha\n\nbeta\ngamma\n"++      it "handles nested standalone blocks" $ do+        let vars = Map.fromList [("a", VBool True), ("b", VBool True)]+            tpl =+              "head\n\+              \{{#if Eq a true}}\n\+              \outer\n\+              \{{#if Eq b true}}\n\+              \inner\n\+              \{{/if}}\n\+              \outer-tail\n\+              \{{/if}}\n\+              \tail\n"+        renderTemplateText tpl vars+          `shouldBe` Right "head\nouter\ninner\nouter-tail\ntail\n"
+ test/Seihou/Engine/ValidateSpec.hs view
@@ -0,0 +1,491 @@+module Seihou.Engine.ValidateSpec (tests) where++import Data.Text qualified as T+import Seihou.Core.Types+import Seihou.Engine.Validate+import System.Directory (createDirectoryIfMissing)+import System.FilePath ((</>))+import System.IO.Temp (withSystemTempDirectory)+import Test.Hspec+import Test.Tasty+import Test.Tasty.Hspec (testSpec)++tests :: IO TestTree+tests = testSpec "Seihou.Engine.Validate" spec++-- | A well-formed module for validation tests.+goodModule :: Module+goodModule =+  Module+    { name = "test-module",+      version = Just "1.0.0",+      description = Just "A test module",+      vars =+        [ VarDecl+            { name = "project.name",+              type_ = VTText,+              default_ = Nothing,+              description = Just "Project name",+              required = True,+              validation = Nothing+            }+        ],+      exports = [VarExport {var = "project.name", alias = Nothing}],+      prompts = [Prompt {var = "project.name", text = "Name?", condition = Nothing, choices = Nothing}],+      steps =+        [ Step+            { strategy = Template,+              src = "README.md.tpl",+              dest = "README.md",+              condition = Nothing,+              patch = Nothing+            }+        ],+      commands = [],+      dependencies = [],+      removal = Nothing,+      migrations = []+    }++-- | A module with multiple validation errors.+badModule :: Module+badModule =+  Module+    { name = "BadName",+      version = Nothing,+      description = Nothing,+      vars =+        [ VarDecl "x" VTText Nothing Nothing True Nothing,+          VarDecl "x" VTBool Nothing Nothing False Nothing+        ],+      exports = [VarExport {var = "nonexistent", alias = Nothing}],+      prompts = [Prompt {var = "undeclared", text = "?", condition = Nothing, choices = Nothing}],+      steps = [Step Template "missing.tpl" "/absolute/path" Nothing Nothing],+      commands = [],+      dependencies = [],+      removal = Nothing,+      migrations = []+    }++-- | Helper to update Module fields without ambiguity.+withVars :: [VarDecl] -> Module -> Module+withVars v m = Module m.name m.version m.description v m.exports m.prompts m.steps m.commands m.dependencies m.removal m.migrations++withSteps :: [Step] -> Module -> Module+withSteps s m = Module m.name m.version m.description m.vars m.exports m.prompts s m.commands m.dependencies m.removal m.migrations++withPrompts :: [Prompt] -> Module -> Module+withPrompts p m = Module m.name m.version m.description m.vars m.exports p m.steps m.commands m.dependencies m.removal m.migrations++withCommands :: [Command] -> Module -> Module+withCommands c m = Module m.name m.version m.description m.vars m.exports m.prompts m.steps c m.dependencies m.removal m.migrations++withVarsAndPrompts :: [VarDecl] -> [Prompt] -> Module -> Module+withVarsAndPrompts v p m = Module m.name m.version m.description v m.exports p m.steps m.commands m.dependencies m.removal m.migrations++-- | Helper: check if any DiagCheck has the given label and non-empty details.+hasFailedCheck :: T.Text -> [DiagCheck] -> Bool+hasFailedCheck label = any (\c -> c.diagLabel == label && not (null (c.diagDetails)))++-- | Helper: check if any DiagCheck has the given label and empty details (pass).+hasPassedCheck :: T.Text -> [DiagCheck] -> Bool+hasPassedCheck label = any (\c -> c.diagLabel == label && null (c.diagDetails))++-- | Helper: count checks with non-empty details of a given severity.+countFailures :: DiagSeverity -> [DiagCheck] -> Int+countFailures sev = length . filter (\c -> c.diagSeverity == sev && not (null (c.diagDetails)))++spec :: Spec+spec = do+  describe "buildReport" $ do+    it "produces all-pass checks for a valid module" $ do+      withSystemTempDirectory "seihou-validate" $ \tmpDir -> do+        createDirectoryIfMissing True (tmpDir </> "files")+        writeFile (tmpDir </> "files" </> "README.md.tpl") "stub"+        report <- buildReport False tmpDir goodModule+        report.reportDhallOk `shouldBe` True+        reportHasErrors report `shouldBe` False+        countFailures DiagError report.reportChecks `shouldBe` 0++    it "detects module name format errors" $ do+      withSystemTempDirectory "seihou-validate" $ \tmpDir -> do+        report <- buildReport False tmpDir badModule+        hasFailedCheck "Module name format" report.reportChecks `shouldBe` True++    it "detects duplicate variable names" $ do+      withSystemTempDirectory "seihou-validate" $ \tmpDir -> do+        report <- buildReport False tmpDir badModule+        hasFailedCheck "Unique variable names" report.reportChecks `shouldBe` True++    it "detects export referencing undeclared variable" $ do+      withSystemTempDirectory "seihou-validate" $ \tmpDir -> do+        report <- buildReport False tmpDir badModule+        hasFailedCheck "Export references" report.reportChecks `shouldBe` True++    it "detects prompt referencing undeclared variable" $ do+      withSystemTempDirectory "seihou-validate" $ \tmpDir -> do+        report <- buildReport False tmpDir badModule+        hasFailedCheck "Prompt references" report.reportChecks `shouldBe` True++    it "detects missing source files" $ do+      withSystemTempDirectory "seihou-validate" $ \tmpDir -> do+        report <- buildReport False tmpDir badModule+        hasFailedCheck "Source file existence" report.reportChecks `shouldBe` True++    it "detects unsafe step destinations" $ do+      withSystemTempDirectory "seihou-validate" $ \tmpDir -> do+        report <- buildReport False tmpDir badModule+        hasFailedCheck "Safe step destinations" report.reportChecks `shouldBe` True++    it "detects missing module version" $ do+      withSystemTempDirectory "seihou-validate" $ \tmpDir -> do+        report <- buildReport False tmpDir badModule+        hasFailedCheck "Module version declared" report.reportChecks `shouldBe` True++    it "passes when module has a version" $ do+      withSystemTempDirectory "seihou-validate" $ \tmpDir -> do+        createDirectoryIfMissing True (tmpDir </> "files")+        writeFile (tmpDir </> "files" </> "README.md.tpl") "stub"+        report <- buildReport False tmpDir goodModule+        hasPassedCheck "Module version declared" report.reportChecks `shouldBe` True++    it "reports multiple errors at once" $ do+      withSystemTempDirectory "seihou-validate" $ \tmpDir -> do+        report <- buildReport False tmpDir badModule+        reportHasErrors report `shouldBe` True+        countFailures DiagError report.reportChecks `shouldSatisfy` (>= 5)++    it "does not include lint checks when lint is False" $ do+      withSystemTempDirectory "seihou-validate" $ \tmpDir -> do+        createDirectoryIfMissing True (tmpDir </> "files")+        writeFile (tmpDir </> "files" </> "README.md.tpl") "stub"+        report <- buildReport False tmpDir goodModule+        let hasWarning = any (\c -> c.diagSeverity == DiagWarning) report.reportChecks+        hasWarning `shouldBe` False++    it "includes lint checks when lint is True" $ do+      withSystemTempDirectory "seihou-validate" $ \tmpDir -> do+        createDirectoryIfMissing True (tmpDir </> "files")+        writeFile (tmpDir </> "files" </> "README.md.tpl") "stub"+        report <- buildReport True tmpDir goodModule+        let hasWarning = any (\c -> c.diagSeverity == DiagWarning) report.reportChecks+        hasWarning `shouldBe` True++  describe "lint checks" $ do+    it "detects unused variables" $ do+      withSystemTempDirectory "seihou-validate" $ \tmpDir -> do+        createDirectoryIfMissing True (tmpDir </> "files")+        writeFile (tmpDir </> "files" </> "README.md.tpl") "stub"+        let m =+              withVars+                [ VarDecl "project.name" VTText Nothing (Just "Name") True Nothing,+                  VarDecl "unused.var" VTText Nothing (Just "Unused") False Nothing+                ]+                goodModule+        report <- buildReport True tmpDir m+        hasFailedCheck "Unused variables" report.reportChecks `shouldBe` True+        let details = concatMap (.diagDetails) $ filter (\c -> c.diagLabel == "Unused variables") report.reportChecks+        any (T.isInfixOf "unused.var") details `shouldBe` True++    it "does not flag used variables as unused" $ do+      withSystemTempDirectory "seihou-validate" $ \tmpDir -> do+        createDirectoryIfMissing True (tmpDir </> "files")+        writeFile (tmpDir </> "files" </> "README.md.tpl") "stub"+        report <- buildReport True tmpDir goodModule+        hasFailedCheck "Unused variables" report.reportChecks `shouldBe` False++    it "detects required variables without prompts" $ do+      withSystemTempDirectory "seihou-validate" $ \tmpDir -> do+        createDirectoryIfMissing True (tmpDir </> "files")+        writeFile (tmpDir </> "files" </> "README.md.tpl") "stub"+        let m =+              withVarsAndPrompts+                [VarDecl "project.name" VTText Nothing (Just "Name") True Nothing]+                []+                goodModule+        report <- buildReport True tmpDir m+        hasFailedCheck "Required variables without prompts" report.reportChecks `shouldBe` True++    it "does not flag required variables that have prompts" $ do+      withSystemTempDirectory "seihou-validate" $ \tmpDir -> do+        createDirectoryIfMissing True (tmpDir </> "files")+        writeFile (tmpDir </> "files" </> "README.md.tpl") "stub"+        report <- buildReport True tmpDir goodModule+        hasFailedCheck "Required variables without prompts" report.reportChecks `shouldBe` False++    it "detects duplicate step destinations" $ do+      withSystemTempDirectory "seihou-validate" $ \tmpDir -> do+        createDirectoryIfMissing True (tmpDir </> "files")+        writeFile (tmpDir </> "files" </> "a.tpl") "stub"+        writeFile (tmpDir </> "files" </> "b.tpl") "stub"+        let m =+              withSteps+                [ Step Template "a.tpl" "out.txt" Nothing Nothing,+                  Step Template "b.tpl" "out.txt" Nothing Nothing+                ]+                goodModule+        report <- buildReport True tmpDir m+        hasFailedCheck "Duplicate step destinations" report.reportChecks `shouldBe` True++    it "does not flag patch ops as duplicate destinations" $ do+      withSystemTempDirectory "seihou-validate" $ \tmpDir -> do+        createDirectoryIfMissing True (tmpDir </> "files")+        writeFile (tmpDir </> "files" </> "a.tpl") "stub"+        writeFile (tmpDir </> "files" </> "b.tpl") "stub"+        let m =+              withSteps+                [ Step Template "a.tpl" "out.txt" Nothing Nothing,+                  Step Template "b.tpl" "out.txt" Nothing (Just AppendFile)+                ]+                goodModule+        report <- buildReport True tmpDir m+        hasFailedCheck "Duplicate step destinations" report.reportChecks `shouldBe` False++    it "detects empty choice lists" $ do+      withSystemTempDirectory "seihou-validate" $ \tmpDir -> do+        createDirectoryIfMissing True (tmpDir </> "files")+        writeFile (tmpDir </> "files" </> "README.md.tpl") "stub"+        let m =+              withVars+                [VarDecl "pick" (VTChoice []) Nothing (Just "Pick") True Nothing]+                goodModule+        report <- buildReport True tmpDir m+        hasFailedCheck "Empty choice lists" report.reportChecks `shouldBe` True++    it "detects missing variable descriptions" $ do+      withSystemTempDirectory "seihou-validate" $ \tmpDir -> do+        createDirectoryIfMissing True (tmpDir </> "files")+        writeFile (tmpDir </> "files" </> "README.md.tpl") "stub"+        let m =+              withVars+                [VarDecl "project.name" VTText Nothing Nothing True Nothing]+                goodModule+        report <- buildReport True tmpDir m+        hasFailedCheck "Missing variable descriptions" report.reportChecks `shouldBe` True++    it "does not flag variables with descriptions" $ do+      withSystemTempDirectory "seihou-validate" $ \tmpDir -> do+        createDirectoryIfMissing True (tmpDir </> "files")+        writeFile (tmpDir </> "files" </> "README.md.tpl") "stub"+        report <- buildReport True tmpDir goodModule+        hasFailedCheck "Missing variable descriptions" report.reportChecks `shouldBe` False++  describe "conditional lint" $ do+    -- Base vars: keep project.name (referenced by goodModule's export/prompt)+    -- and add a bool feature flag for the comparison tests.+    let baseVars =+          [ VarDecl "project.name" VTText Nothing (Just "Name") True Nothing,+            VarDecl "feature.on" VTBool Nothing (Just "Feature flag") False Nothing+          ]+        stepWithCondition cond =+          withSteps+            [Step Template "README.md.tpl" "README.md" cond Nothing]+            (withVars baseVars goodModule)++    it "flags a bool variable compared against a string literal in a when clause" $ do+      withSystemTempDirectory "seihou-validate" $ \tmpDir -> do+        createDirectoryIfMissing True (tmpDir </> "files")+        writeFile (tmpDir </> "files" </> "README.md.tpl") "stub"+        let m = stepWithCondition (Just (ExprEq "feature.on" (VText "true")))+        report <- buildReport True tmpDir m+        hasFailedCheck "Conditional comparison types" report.reportChecks `shouldBe` True+        reportHasErrors report `shouldBe` True+        let details =+              concatMap (.diagDetails) $+                filter (\c -> c.diagLabel == "Conditional comparison types") report.reportChecks+        any (T.isInfixOf "feature.on") details `shouldBe` True+        any (T.isInfixOf "bareword true") details `shouldBe` True++    it "does not flag a bool variable compared against a bareword true" $ do+      withSystemTempDirectory "seihou-validate" $ \tmpDir -> do+        createDirectoryIfMissing True (tmpDir </> "files")+        writeFile (tmpDir </> "files" </> "README.md.tpl") "stub"+        let m = stepWithCondition (Just (ExprEq "feature.on" (VBool True)))+        report <- buildReport True tmpDir m+        hasFailedCheck "Conditional comparison types" report.reportChecks `shouldBe` False+        hasPassedCheck "Conditional comparison types" report.reportChecks `shouldBe` True++    it "flags a when clause referencing an undeclared variable" $ do+      withSystemTempDirectory "seihou-validate" $ \tmpDir -> do+        createDirectoryIfMissing True (tmpDir </> "files")+        writeFile (tmpDir </> "files" </> "README.md.tpl") "stub"+        let m = stepWithCondition (Just (ExprIsSet "nix.treefmtt"))+        report <- buildReport True tmpDir m+        hasFailedCheck "Conditional variable references" report.reportChecks `shouldBe` True+        let details =+              concatMap (.diagDetails) $+                filter (\c -> c.diagLabel == "Conditional variable references") report.reportChecks+        any (T.isInfixOf "nix.treefmtt") details `shouldBe` True++    it "passes both conditional checks for a correct module" $ do+      withSystemTempDirectory "seihou-validate" $ \tmpDir -> do+        createDirectoryIfMissing True (tmpDir </> "files")+        writeFile (tmpDir </> "files" </> "README.md.tpl") "stub"+        let m = stepWithCondition (Just (ExprEq "feature.on" (VBool True)))+        report <- buildReport True tmpDir m+        hasPassedCheck "Conditional variable references" report.reportChecks `shouldBe` True+        hasPassedCheck "Conditional comparison types" report.reportChecks `shouldBe` True++    it "does not run conditional checks when lint is False" $ do+      withSystemTempDirectory "seihou-validate" $ \tmpDir -> do+        createDirectoryIfMissing True (tmpDir </> "files")+        writeFile (tmpDir </> "files" </> "README.md.tpl") "stub"+        let m = stepWithCondition (Just (ExprEq "feature.on" (VText "true")))+        report <- buildReport False tmpDir m+        any (\c -> c.diagLabel == "Conditional comparison types") report.reportChecks+          `shouldBe` False+        reportHasErrors report `shouldBe` False++    it "flags an undeclared variable referenced in a template {{#if}} conditional" $ do+      withSystemTempDirectory "seihou-validate" $ \tmpDir -> do+        createDirectoryIfMissing True (tmpDir </> "files")+        writeFile+          (tmpDir </> "files" </> "README.md.tpl")+          "{{#if Eq ghost true}}\nhi\n{{/if}}\n"+        let m = withVars baseVars goodModule+        report <- buildReport True tmpDir m+        hasFailedCheck "Conditional variable references" report.reportChecks `shouldBe` True+        let details =+              concatMap (.diagDetails) $+                filter (\c -> c.diagLabel == "Conditional variable references") report.reportChecks+        any (T.isInfixOf "ghost") details `shouldBe` True+        any (T.isInfixOf "README.md.tpl") details `shouldBe` True++    it "flags a bool var compared to a string literal inside a template {{#if}}" $ do+      withSystemTempDirectory "seihou-validate" $ \tmpDir -> do+        createDirectoryIfMissing True (tmpDir </> "files")+        writeFile+          (tmpDir </> "files" </> "README.md.tpl")+          "{{#if Eq feature.on \"true\"}}\nhi\n{{/if}}\n"+        let m = withVars baseVars goodModule+        report <- buildReport True tmpDir m+        hasFailedCheck "Conditional comparison types" report.reportChecks `shouldBe` True++  describe "renderReportPlain" $ do+    it "renders a valid module report with check marks" $ do+      withSystemTempDirectory "seihou-validate" $ \tmpDir -> do+        createDirectoryIfMissing True (tmpDir </> "files")+        writeFile (tmpDir </> "files" </> "README.md.tpl") "stub"+        report <- buildReport False tmpDir goodModule+        let rendered = renderReportPlain report+        T.isInfixOf "\x2713 module.dhall evaluates successfully" rendered `shouldBe` True+        T.isInfixOf "\x2713 Module name: test-module" rendered `shouldBe` True+        T.isInfixOf "Module 'test-module' is valid." rendered `shouldBe` True++    it "renders an invalid module report with cross marks and error count" $ do+      withSystemTempDirectory "seihou-validate" $ \tmpDir -> do+        report <- buildReport False tmpDir badModule+        let rendered = renderReportPlain report+        T.isInfixOf "\x2717 Module name format" rendered `shouldBe` True+        T.isInfixOf "error(s) found. Module is invalid." rendered `shouldBe` True++    it "renders a Dhall-failure report" $ do+      let report =+            ValidateReport+              { reportModule = goodModule,+                reportPath = "/some/path",+                reportDhallOk = False,+                reportDhallError = Just "test error message",+                reportChecks = []+              }+          rendered = renderReportPlain report+      T.isInfixOf "\x2717 module.dhall failed to evaluate" rendered `shouldBe` True+      T.isInfixOf "test error message" rendered `shouldBe` True+      T.isInfixOf "1 error(s) found. Module is invalid." rendered `shouldBe` True++    it "renders a Dhall-failure report without error details when absent" $ do+      let report =+            ValidateReport+              { reportModule = goodModule,+                reportPath = "/some/path",+                reportDhallOk = False,+                reportDhallError = Nothing,+                reportChecks = []+              }+          rendered = renderReportPlain report+      T.isInfixOf "\x2717 module.dhall failed to evaluate" rendered `shouldBe` True+      T.isInfixOf "1 error(s) found. Module is invalid." rendered `shouldBe` True++    it "renders lint warnings with warning symbol" $ do+      withSystemTempDirectory "seihou-validate" $ \tmpDir -> do+        createDirectoryIfMissing True (tmpDir </> "files")+        writeFile (tmpDir </> "files" </> "README.md.tpl") "stub"+        let m =+              withVars+                [ VarDecl "project.name" VTText Nothing (Just "Name") True Nothing,+                  VarDecl "unused" VTText Nothing (Just "Unused") False Nothing+                ]+                goodModule+        report <- buildReport True tmpDir m+        let rendered = renderReportPlain report+        T.isInfixOf "\x26A0 Unused variables" rendered `shouldBe` True++  describe "reportHasErrors" $ do+    it "returns False for a valid report" $ do+      withSystemTempDirectory "seihou-validate" $ \tmpDir -> do+        createDirectoryIfMissing True (tmpDir </> "files")+        writeFile (tmpDir </> "files" </> "README.md.tpl") "stub"+        report <- buildReport False tmpDir goodModule+        reportHasErrors report `shouldBe` False++    it "returns True for a report with errors" $ do+      withSystemTempDirectory "seihou-validate" $ \tmpDir -> do+        report <- buildReport False tmpDir badModule+        reportHasErrors report `shouldBe` True++    it "returns False when only warnings are present" $ do+      withSystemTempDirectory "seihou-validate" $ \tmpDir -> do+        createDirectoryIfMissing True (tmpDir </> "files")+        writeFile (tmpDir </> "files" </> "README.md.tpl") "stub"+        let m =+              withVars+                [ VarDecl "project.name" VTText Nothing (Just "Name") True Nothing,+                  VarDecl "unused" VTText Nothing (Just "Unused") False Nothing+                ]+                goodModule+        report <- buildReport True tmpDir m+        reportHasErrors report `shouldBe` False++    it "returns True when Dhall failed" $ do+      let report =+            ValidateReport+              { reportModule = goodModule,+                reportPath = "/some/path",+                reportDhallOk = False,+                reportDhallError = Just "some dhall error",+                reportChecks = []+              }+      reportHasErrors report `shouldBe` True++  describe "command safety" $ do+    it "passes for valid commands" $ do+      withSystemTempDirectory "seihou-validate" $ \tmpDir -> do+        createDirectoryIfMissing True (tmpDir </> "files")+        writeFile (tmpDir </> "files" </> "README.md.tpl") "stub"+        let m = withCommands [Command "echo hello" Nothing Nothing] goodModule+        report <- buildReport False tmpDir m+        hasPassedCheck "Command safety" report.reportChecks `shouldBe` True++    it "fails for empty command text" $ do+      withSystemTempDirectory "seihou-validate" $ \tmpDir -> do+        createDirectoryIfMissing True (tmpDir </> "files")+        writeFile (tmpDir </> "files" </> "README.md.tpl") "stub"+        let m = withCommands [Command "  " Nothing Nothing] goodModule+        report <- buildReport False tmpDir m+        hasFailedCheck "Command safety" report.reportChecks `shouldBe` True++    it "fails for absolute workDir" $ do+      withSystemTempDirectory "seihou-validate" $ \tmpDir -> do+        createDirectoryIfMissing True (tmpDir </> "files")+        writeFile (tmpDir </> "files" </> "README.md.tpl") "stub"+        let m = withCommands [Command "echo hi" (Just "/usr/local") Nothing] goodModule+        report <- buildReport False tmpDir m+        hasFailedCheck "Command safety" report.reportChecks `shouldBe` True++    it "fails for workDir containing .." $ do+      withSystemTempDirectory "seihou-validate" $ \tmpDir -> do+        createDirectoryIfMissing True (tmpDir </> "files")+        writeFile (tmpDir </> "files" </> "README.md.tpl") "stub"+        let m = withCommands [Command "echo hi" (Just "../escape") Nothing] goodModule+        report <- buildReport False tmpDir m+        hasFailedCheck "Command safety" report.reportChecks `shouldBe` True
+ test/Seihou/Evaluation/ConditionalTemplateSpec.hs view
@@ -0,0 +1,82 @@+module Seihou.Evaluation.ConditionalTemplateSpec (tests) where++import Data.Map.Strict qualified as Map+import Data.Text (Text)+import Data.Text.IO qualified as TIO+import Seihou.Core.Module (loadModule)+import Seihou.Core.Types+import Seihou.Engine.Plan (compilePlan)+import Seihou.Engine.Template (renderTemplate)+import System.Directory (getCurrentDirectory)+import System.FilePath (takeDirectory, (</>))+import Test.Hspec+import Test.Tasty+import Test.Tasty.Hspec (testSpec)++tests :: IO TestTree+tests = testSpec "Seihou.Evaluation.ConditionalTemplate" spec++-- | Variable set shared by both postgres on/off runs.+commonVars :: Map.Map VarName VarValue+commonVars =+  Map.fromList+    [ ("project.name", VText "demo-app"),+      ("project.description", VText "A demo Haskell application"),+      ("ghc.version", VText "ghc912"),+      ("nix.process-compose", VBool True)+    ]++fixtureDir :: IO FilePath+fixtureDir = do+  cwd <- getCurrentDirectory+  pure (cwd </> "test" </> "fixtures" </> "evaluation" </> "conditional-template-flake")++splitFlakeBaseline :: FilePath -> Map.Map VarName VarValue -> IO Text+splitFlakeBaseline tplName vars = do+  cwd <- getCurrentDirectory+  raw <-+    TIO.readFile+      ( cwd+          </> "test"+          </> "fixtures"+          </> "evaluation"+          </> "split-flake"+          </> "files"+          </> tplName+      )+  case renderTemplate raw vars of+    Left errs -> fail ("renderTemplate failed: " <> show errs)+    Right t -> pure t++spec :: Spec+spec = do+  describe "conditional-template-flake fixture (compilePlan)" $ do+    it "with nix.postgresql = false, emits bytes identical to the non-postgres split-flake baseline" $ do+      base <- fixtureDir+      Right modul <- loadModule [takeDirectory base] "conditional-template-flake"+      let vars = Map.insert "nix.postgresql" (VBool False) commonVars+      planResult <- compilePlan base modul vars+      case planResult of+        Left errs -> expectationFailure ("compilePlan failed: " <> show errs)+        Right ops -> do+          let writeOps = [op | op@WriteFileOp {} <- ops]+          writeOps `shouldSatisfy` (\xs -> length xs == 1)+          let op = writeOps !! 0+          op.dest `shouldBe` "flake.nix"+          expected <- splitFlakeBaseline "flake.nix.tpl" vars+          op.content `shouldBe` expected++    it "with nix.postgresql = true, emits bytes identical to the postgres split-flake baseline" $ do+      base <- fixtureDir+      Right modul <- loadModule [takeDirectory base] "conditional-template-flake"+      let vars = Map.insert "nix.postgresql" (VBool True) commonVars+      planResult <- compilePlan base modul vars+      case planResult of+        Left errs -> expectationFailure ("compilePlan failed: " <> show errs)+        Right ops -> do+          let writeOps = [op | op@WriteFileOp {} <- ops]+          writeOps `shouldSatisfy` (\xs -> length xs == 1)+          let op = writeOps !! 0+          op.dest `shouldBe` "flake.nix"+          expected <- splitFlakeBaseline "flake-with-postgres.nix.tpl" vars+          op.content `shouldBe` expected
+ test/Seihou/Evaluation/DhallTextFlakeSpec.hs view
@@ -0,0 +1,79 @@+module Seihou.Evaluation.DhallTextFlakeSpec (tests) where++import Data.Map.Strict qualified as Map+import Data.Text (Text)+import Data.Text.IO qualified as TIO+import Seihou.Core.Module (loadModule)+import Seihou.Core.Types+import Seihou.Engine.Plan (compilePlan)+import Seihou.Engine.Template (renderTemplate)+import System.Directory (getCurrentDirectory)+import System.FilePath (takeDirectory, (</>))+import Test.Hspec+import Test.Tasty+import Test.Tasty.Hspec (testSpec)++tests :: IO TestTree+tests = testSpec "Seihou.Evaluation.DhallTextFlake" spec++commonVars :: Map.Map VarName VarValue+commonVars =+  Map.fromList+    [ ("project.name", VText "demo-app"),+      ("project.description", VText "A demo Haskell application"),+      ("ghc.version", VText "ghc912"),+      ("nix.process-compose", VBool True)+    ]++fixtureDir :: IO FilePath+fixtureDir = do+  cwd <- getCurrentDirectory+  pure (cwd </> "test" </> "fixtures" </> "evaluation" </> "dhall-text-flake")++splitFlakeDir :: IO FilePath+splitFlakeDir = do+  cwd <- getCurrentDirectory+  pure (cwd </> "test" </> "fixtures" </> "evaluation" </> "split-flake")++-- | Render one of the split-flake baseline templates to produce the expected+-- byte string that the Prototype A output must match.+renderSplitFlake :: FilePath -> Map.Map VarName VarValue -> IO Text+renderSplitFlake tplName vars = do+  base <- splitFlakeDir+  raw <- TIO.readFile (base </> "files" </> tplName)+  case renderTemplate raw vars of+    Left errs -> fail ("renderTemplate failed: " <> show errs)+    Right t -> pure t++spec :: Spec+spec = do+  describe "dhall-text-flake fixture (Prototype A)" $ do+    it "with nix.postgresql = false, produces bytes identical to the non-postgres baseline" $ do+      base <- fixtureDir+      Right modul <- loadModule [takeDirectory base] "dhall-text-flake"+      let vars = Map.insert "nix.postgresql" (VBool False) commonVars+      planResult <- compilePlan base modul vars+      case planResult of+        Left errs -> expectationFailure ("compilePlan failed: " <> show errs)+        Right ops -> do+          let writeOps = [op | op@WriteFileOp {} <- ops]+          writeOps `shouldSatisfy` (\xs -> length xs == 1)+          let op = writeOps !! 0+          op.dest `shouldBe` "flake.nix"+          expected <- renderSplitFlake "flake.nix.tpl" vars+          op.content `shouldBe` expected++    it "with nix.postgresql = true, produces bytes identical to the postgres baseline" $ do+      base <- fixtureDir+      Right modul <- loadModule [takeDirectory base] "dhall-text-flake"+      let vars = Map.insert "nix.postgresql" (VBool True) commonVars+      planResult <- compilePlan base modul vars+      case planResult of+        Left errs -> expectationFailure ("compilePlan failed: " <> show errs)+        Right ops -> do+          let writeOps = [op | op@WriteFileOp {} <- ops]+          writeOps `shouldSatisfy` (\xs -> length xs == 1)+          let op = writeOps !! 0+          op.dest `shouldBe` "flake.nix"+          expected <- renderSplitFlake "flake-with-postgres.nix.tpl" vars+          op.content `shouldBe` expected
+ test/Seihou/Evaluation/SplitFlakeSpec.hs view
@@ -0,0 +1,73 @@+module Seihou.Evaluation.SplitFlakeSpec (tests) where++import Data.Map.Strict qualified as Map+import Data.Text (Text)+import Data.Text.IO qualified as TIO+import Seihou.Core.Module (loadModule)+import Seihou.Core.Types+import Seihou.Engine.Plan (compilePlan)+import Seihou.Engine.Template (renderTemplate)+import System.Directory (getCurrentDirectory)+import System.FilePath (takeDirectory, (</>))+import Test.Hspec+import Test.Tasty+import Test.Tasty.Hspec (testSpec)++tests :: IO TestTree+tests = testSpec "Seihou.Evaluation.SplitFlake" spec++-- | Variable set common to both variants.+commonVars :: Map.Map VarName VarValue+commonVars =+  Map.fromList+    [ ("project.name", VText "demo-app"),+      ("project.description", VText "A demo Haskell application"),+      ("ghc.version", VText "ghc912"),+      ("nix.process-compose", VBool True)+    ]++fixtureDir :: IO FilePath+fixtureDir = do+  cwd <- getCurrentDirectory+  pure (cwd </> "test" </> "fixtures" </> "evaluation" </> "split-flake")++renderFixtureFile :: FilePath -> Map.Map VarName VarValue -> IO Text+renderFixtureFile src vars = do+  base <- fixtureDir+  raw <- TIO.readFile (base </> "files" </> src)+  case renderTemplate raw vars of+    Left errs -> fail ("renderTemplate failed: " <> show errs)+    Right t -> pure t++spec :: Spec+spec = do+  describe "split-flake fixture" $ do+    it "with nix.postgresql = false, emits the non-postgres flake verbatim" $ do+      base <- fixtureDir+      Right modul <- loadModule [takeDirectory base] "split-flake"+      let vars = Map.insert "nix.postgresql" (VBool False) commonVars+      planResult <- compilePlan base modul vars+      case planResult of+        Left errs -> expectationFailure ("compilePlan failed: " <> show errs)+        Right ops -> do+          let writeOps = [op | op@WriteFileOp {} <- ops]+          writeOps `shouldSatisfy` (\xs -> length xs == 1)+          let op = writeOps !! 0+          op.dest `shouldBe` "flake.nix"+          expected <- renderFixtureFile "flake.nix.tpl" vars+          op.content `shouldBe` expected++    it "with nix.postgresql = true, emits the postgres flake verbatim" $ do+      base <- fixtureDir+      Right modul <- loadModule [takeDirectory base] "split-flake"+      let vars = Map.insert "nix.postgresql" (VBool True) commonVars+      planResult <- compilePlan base modul vars+      case planResult of+        Left errs -> expectationFailure ("compilePlan failed: " <> show errs)+        Right ops -> do+          let writeOps = [op | op@WriteFileOp {} <- ops]+          writeOps `shouldSatisfy` (\xs -> length xs == 1)+          let op = writeOps !! 0+          op.dest `shouldBe` "flake.nix"+          expected <- renderFixtureFile "flake-with-postgres.nix.tpl" vars+          op.content `shouldBe` expected
+ test/Seihou/Evaluation/TypedDhallTextSpec.hs view
@@ -0,0 +1,110 @@+module Seihou.Evaluation.TypedDhallTextSpec (tests) where++import Data.Map.Strict qualified as Map+import Data.Text (Text)+import Data.Text qualified as T+import Data.Text.IO qualified as TIO+import Seihou.Core.Types+import Seihou.Engine.Template (renderTemplate)+import Seihou.Engine.TypedDhallText (fieldNameFor, renderTypedDhallText)+import System.Directory (getCurrentDirectory)+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.Evaluation.TypedDhallText" spec++commonVars :: Map.Map VarName VarValue+commonVars =+  Map.fromList+    [ ("project.name", VText "demo-app"),+      ("project.description", VText "A demo Haskell application"),+      ("ghc.version", VText "ghc912"),+      ("nix.process-compose", VBool True)+    ]++fixtureSource :: IO FilePath+fixtureSource = do+  cwd <- getCurrentDirectory+  pure+    ( cwd+        </> "test"+        </> "fixtures"+        </> "evaluation"+        </> "typed-dhall-text-flake"+        </> "files"+        </> "flake.nix.dhall"+    )++splitFlakeDir :: IO FilePath+splitFlakeDir = do+  cwd <- getCurrentDirectory+  pure (cwd </> "test" </> "fixtures" </> "evaluation" </> "split-flake")++renderSplitFlake :: FilePath -> Map.Map VarName VarValue -> IO Text+renderSplitFlake tplName vars = do+  base <- splitFlakeDir+  raw <- TIO.readFile (base </> "files" </> tplName)+  case renderTemplate raw vars of+    Left errs -> fail ("renderTemplate failed: " <> show errs)+    Right t -> pure t++spec :: Spec+spec = do+  describe "fieldNameFor" $ do+    it "replaces dots with underscores" $+      fieldNameFor "project.name" `shouldBe` "project_name"++    it "replaces dashes with underscores" $+      fieldNameFor "nix.process-compose" `shouldBe` "nix_process_compose"++  describe "typed-dhall-text-flake fixture (Prototype B)" $ do+    it "with nix.postgresql = false, produces bytes identical to the non-postgres baseline" $ do+      src <- fixtureSource+      let vars = Map.insert "nix.postgresql" (VBool False) commonVars+      result <- renderTypedDhallText src vars+      case result of+        Left err -> expectationFailure ("renderTypedDhallText failed: " <> T.unpack err)+        Right txt -> do+          expected <- renderSplitFlake "flake.nix.tpl" vars+          txt `shouldBe` expected++    it "with nix.postgresql = true, produces bytes identical to the postgres baseline" $ do+      src <- fixtureSource+      let vars = Map.insert "nix.postgresql" (VBool True) commonVars+      result <- renderTypedDhallText src vars+      case result of+        Left err -> expectationFailure ("renderTypedDhallText failed: " <> T.unpack err)+        Right txt -> do+          expected <- renderSplitFlake "flake-with-postgres.nix.tpl" vars+          txt `shouldBe` expected++    it "reports a field-name typo with the offending field in the error message" $ do+      -- Seed a typo: the source says nix_postgres but the record provides+      -- nix_postgresql. Dhall must report the mismatch mentioning one of them.+      withSystemTempDirectory "seihou-typed-dhall" $ \tmp -> do+        let typoSrc = tmp </> "typo.dhall"+            typoSource =+              T.unlines+                [ "\\(vars :",+                  "    { project_name         : Text",+                  "    , project_description  : Text",+                  "    , ghc_version          : Text",+                  "    , nix_process_compose  : Bool",+                  "    , nix_postgres         : Bool",+                  "    }",+                  "  ) ->",+                  "  \"${vars.project_name} ${vars.ghc_version}\""+                ]+        TIO.writeFile typoSrc typoSource+        let vars = Map.insert "nix.postgresql" (VBool False) commonVars+        result <- renderTypedDhallText typoSrc vars+        case result of+          Right _ -> expectationFailure "Expected a Dhall type error"+          Left err -> do+            -- The error text must mention either the missing field name from+            -- the lambda type annotation or the extra field on the record.+            T.isInfixOf "nix_postgres" err `shouldBe` True
+ test/Seihou/Integration/CompositionSpec.hs view
@@ -0,0 +1,275 @@+module Seihou.Integration.CompositionSpec (tests) where++import Data.Either (isLeft)+import Data.Map.Strict qualified as Map+import Data.Text (Text)+import Data.Text qualified as T+import Seihou.Composition.Graph (buildGraph, topoSort)+import Seihou.Composition.Instance (ModuleInstance (..), primaryInstance)+import Seihou.Composition.Plan (compileComposedPlan)+import Seihou.Composition.Resolve (loadComposition, resolveComposedVariables)+import Seihou.Core.Types+import System.FilePath ((</>))+import Test.Hspec+import Test.Tasty+import Test.Tasty.Hspec (testSpec)++tests :: IO TestTree+tests = testSpec "Seihou.Integration.Composition" spec++fixtureDir :: FilePath+fixtureDir = "test/fixtures"++spec :: Spec+spec = do+  describe "loadComposition" $ do+    it "loads haskell-with-nix with all four modules" $ do+      result <- loadComposition [fixtureDir] "haskell-with-nix" []+      case result of+        Left err -> expectationFailure $ "Expected Right, got: " ++ show err+        Right modules -> do+          let names = map (\(_, m, _) -> m.name) modules+          length names `shouldBe` 4+          -- All four modules should be present+          elem "nix-base" names `shouldBe` True+          elem "haskell-base" names `shouldBe` True+          elem "nix-flake" names `shouldBe` True+          elem "haskell-with-nix" names `shouldBe` True++    it "orders dependencies before dependents" $ do+      result <- loadComposition [fixtureDir] "haskell-with-nix" []+      case result of+        Left err -> expectationFailure $ "Expected Right, got: " ++ show err+        Right modules -> do+          let names = map (\(_, m, _) -> m.name) modules+              indexOf n = case lookup n (zip names [0 :: Int ..]) of+                Just i -> i+                Nothing -> error $ "Module not found: " ++ show n+          -- nix-base before nix-flake+          indexOf "nix-base" `shouldSatisfy` (< indexOf "nix-flake")+          -- haskell-base before haskell-with-nix+          indexOf "haskell-base" `shouldSatisfy` (< indexOf "haskell-with-nix")+          -- nix-flake before haskell-with-nix+          indexOf "nix-flake" `shouldSatisfy` (< indexOf "haskell-with-nix")+          -- haskell-with-nix should be last+          indexOf "haskell-with-nix" `shouldBe` 3++    it "loads a single module with no dependencies" $ do+      result <- loadComposition [fixtureDir] "nix-base" []+      case result of+        Left err -> expectationFailure $ "Expected Right, got: " ++ show err+        Right modules -> do+          length modules `shouldBe` 1+          case modules of+            [(_, m, _)] -> m.name `shouldBe` "nix-base"+            _ -> expectationFailure "Expected exactly one module"++    it "handles additional modules via --module flag" $ do+      result <- loadComposition [fixtureDir] "haskell-base" ["nix-base"]+      case result of+        Left err -> expectationFailure $ "Expected Right, got: " ++ show err+        Right modules -> do+          let names = map (\(_, m, _) -> m.name) modules+          length names `shouldBe` 2+          elem "haskell-base" names `shouldBe` True+          elem "nix-base" names `shouldBe` True++    it "returns error for nonexistent dependency" $ do+      result <- loadComposition [fixtureDir] "haskell-with-nix" ["nonexistent"]+      result `shouldSatisfy` isLeft++  describe "resolveComposedVariables" $ do+    it "flows nix.system from nix-base to nix-flake" $ do+      result <- loadComposition [fixtureDir] "nix-flake" []+      case result of+        Left err -> expectationFailure $ "Load failed: " ++ show err+        Right modules -> do+          case resolveComposedVariables modules Map.empty Map.empty "" "" Map.empty Map.empty Map.empty Map.empty of+            Left errs -> expectationFailure $ "Resolve failed: " ++ show errs+            Right resolved -> do+              let flakeVars = resolved Map.! primaryInstance "nix-flake"+              -- nix-flake should see nix.system from nix-base's export+              (.value) (flakeVars Map.! "nix.system") `shouldBe` VText "x86_64-linux"+              -- nix-flake should also have its own variable+              (.value) (flakeVars Map.! "nix.description") `shouldBe` VText "A Nix project"++    it "flows exports through diamond dependency" $ do+      result <- loadComposition [fixtureDir] "haskell-with-nix" []+      case result of+        Left err -> expectationFailure $ "Load failed: " ++ show err+        Right modules -> do+          let cliOverrides = Map.singleton "project.name" "my-app"+          case resolveComposedVariables modules cliOverrides Map.empty "" "" Map.empty Map.empty Map.empty Map.empty of+            Left errs -> expectationFailure $ "Resolve failed: " ++ show errs+            Right resolved -> do+              -- haskell-base should have project.name from CLI+              let baseVars = resolved Map.! primaryInstance "haskell-base"+              (.value) (baseVars Map.! "project.name") `shouldBe` VText "my-app"+              -- haskell-with-nix should inherit project.name via haskell-base's export+              let topVars = resolved Map.! primaryInstance "haskell-with-nix"+              Map.member "project.name" topVars `shouldBe` True+              (.value) (topVars Map.! "project.name") `shouldBe` VText "my-app"++  describe "compileComposedPlan" $ do+    it "produces operations from all composed modules" $ do+      result <- loadComposition [fixtureDir] "haskell-with-nix" []+      case result of+        Left err -> expectationFailure $ "Load failed: " ++ show err+        Right modules -> do+          let cliOverrides = Map.singleton "project.name" "my-app"+          case resolveComposedVariables modules cliOverrides Map.empty "" "" Map.empty Map.empty Map.empty Map.empty of+            Left errs -> expectationFailure $ "Resolve failed: " ++ show errs+            Right resolved -> do+              let quads =+                    [ (inst, m, dir, Map.map (.value) (resolved Map.! inst))+                    | (inst, m, dir) <- modules+                    ]+              planResult <- compileComposedPlan quads+              case planResult of+                Left errs -> expectationFailure $ "Plan failed: " ++ show errs+                Right (ops, warnings, _) -> do+                  -- Should have operations for shell.nix, flake.nix, README.md,+                  -- src/Lib.hs, LICENSE, *.cabal, cabal.project, Makefile (+ dirs)+                  let writeOps = [d | WriteFileOp d _ _ <- ops]+                  elem "shell.nix" writeOps `shouldBe` True+                  elem "flake.nix" writeOps `shouldBe` True+                  elem "Makefile" writeOps `shouldBe` True+                  elem "README.md" writeOps `shouldBe` True++  describe "text patching integration" $ do+    it "haskell-shared-readme appends section to haskell-base README" $ do+      result <- loadComposition [fixtureDir] "haskell-shared-readme" []+      case result of+        Left err -> expectationFailure $ "Load failed: " ++ show err+        Right modules -> do+          let cliOverrides = Map.singleton "project.name" "my-app"+          case resolveComposedVariables modules cliOverrides Map.empty "" "" Map.empty Map.empty Map.empty Map.empty of+            Left errs -> expectationFailure $ "Resolve failed: " ++ show errs+            Right resolved -> do+              let quads =+                    [ (inst, m, dir, Map.map (.value) (resolved Map.! inst))+                    | (inst, m, dir) <- modules+                    ]+              planResult <- compileComposedPlan quads+              case planResult of+                Left errs -> expectationFailure $ "Plan failed: " ++ show errs+                Right (ops, warnings, _) -> do+                  -- Find the merged README.md+                  let readmeOps = [content | WriteFileOp dest content _ <- ops, dest == "README.md"]+                  length readmeOps `shouldBe` 1+                  let readmeContent = head readmeOps+                  -- Should contain the base content from haskell-base+                  T.isInfixOf "# my-app" readmeContent `shouldBe` True+                  -- Should contain the patched section from haskell-shared-readme+                  T.isInfixOf "Additional Section" readmeContent `shouldBe` True+                  T.isInfixOf "seihou:haskell-shared-readme" readmeContent `shouldBe` True+                  -- Should have a ContentMerged warning+                  any isContentMerged warnings `shouldBe` True++  describe "structured merge integration" $ do+    it "two modules contributing to same JSON get deep-merged" $ do+      result <- loadComposition [fixtureDir] "structured-merge-b" []+      case result of+        Left err -> expectationFailure $ "Load failed: " ++ show err+        Right modules -> do+          case resolveComposedVariables modules Map.empty Map.empty "" "" Map.empty Map.empty Map.empty Map.empty of+            Left errs -> expectationFailure $ "Resolve failed: " ++ show errs+            Right resolved -> do+              let quads =+                    [ (inst, m, dir, Map.map (.value) (resolved Map.! inst))+                    | (inst, m, dir) <- modules+                    ]+              planResult <- compileComposedPlan quads+              case planResult of+                Left errs -> expectationFailure $ "Plan failed: " ++ show errs+                Right (ops, warnings, _) -> do+                  -- Find the merged config.json+                  let configOps = [content | WriteFileOp dest content _ <- ops, dest == "config.json"]+                  length configOps `shouldBe` 1+                  let configContent = head configOps+                  -- Should contain keys from module A+                  T.isInfixOf "name" configContent `shouldBe` True+                  T.isInfixOf "my-project" configContent `shouldBe` True+                  -- Should contain keys from module B+                  T.isInfixOf "debug" configContent `shouldBe` True+                  T.isInfixOf "logLevel" configContent `shouldBe` True+                  -- Should have a ContentMerged warning+                  any isContentMerged warnings `shouldBe` True++  describe "multi-instantiation diamond" $ do+    -- These three fixtures (multi-instance-helper/leaf/diamond) model the+    -- agent-seihou master-plan pattern: a parent depends on a leaf that+    -- binds the helper one way, and also directly on the helper bound+    -- the other way. Before ExecPlan 10, only one invocation survived.+    it "loadComposition produces two helper instances with different bindings" $ do+      result <- loadComposition [fixtureDir] "multi-instance-diamond" []+      case result of+        Left err -> expectationFailure $ "Load failed: " ++ show err+        Right modules -> do+          -- Expect: helper (skill.name=diamond), helper (skill.name=leaf),+          --         leaf, diamond — four entries total.+          length modules `shouldBe` 4+          let helperInstances =+                [ inst+                | (inst, m, _) <- modules,+                  m.name == "multi-instance-helper"+                ]+          length helperInstances `shouldBe` 2+          let bindings =+                Map.fromList+                  [ ("diamond" :: Text, True),+                    ("leaf", True)+                  ]+              haveSkill vn =+                any+                  ( \inst ->+                      Map.lookup "skill.name" inst.instanceParentVars.unParentVars == Just vn+                  )+                  helperInstances+          all haveSkill (Map.keys bindings) `shouldBe` True++    it "compileComposedPlan produces two helper output files with distinct names" $ do+      result <- loadComposition [fixtureDir] "multi-instance-diamond" []+      case result of+        Left err -> expectationFailure $ "Load failed: " ++ show err+        Right modules -> do+          case resolveComposedVariables modules Map.empty Map.empty "" "" Map.empty Map.empty Map.empty Map.empty of+            Left errs -> expectationFailure $ "Resolve failed: " ++ show errs+            Right resolved -> do+              let quads =+                    [ (inst, m, dir, Map.map (.value) (resolved Map.! inst))+                    | (inst, m, dir) <- modules+                    ]+              planResult <- compileComposedPlan quads+              case planResult of+                Left errs -> expectationFailure $ "Plan failed: " ++ show errs+                Right (ops, _, _) -> do+                  let writeDests = [d | WriteFileOp d _ _ <- ops]+                  elem "out/leaf.txt" writeDests `shouldBe` True+                  elem "out/diamond.txt" writeDests `shouldBe` True++  describe "cycle detection" $ do+    it "detects a circular dependency" $ do+      let mkMod name deps =+            Module+              { name = name,+                version = Nothing,+                description = Nothing,+                vars = [],+                exports = [],+                prompts = [],+                steps = [],+                commands = [],+                dependencies = map simpleDep deps,+                removal = Nothing,+                migrations = []+              }+          a = mkMod "a" ["b"]+          b = mkMod "b" ["c"]+          c = mkMod "c" ["a"]+          graph = buildGraph [(primaryInstance m.name, m) | m <- [a, b, c]]+      topoSort graph `shouldSatisfy` isLeft++isContentMerged :: CompositionWarning -> Bool+isContentMerged (ContentMerged {}) = True+isContentMerged _ = False
+ test/Seihou/Integration/ExecutionSpec.hs view
@@ -0,0 +1,200 @@+module Seihou.Integration.ExecutionSpec (tests) where++import Data.Map.Strict qualified as Map+import Data.Set qualified as Set+import Data.Text (Text)+import Data.Text qualified as T+import Data.Time (UTCTime, defaultTimeLocale, parseTimeOrError)+import Effectful+import Seihou.Core.Module (loadModule)+import Seihou.Core.Types+import Seihou.Core.Variable (resolveVariables)+import Seihou.Effect.FilesystemPure (PureFS (..), emptyFS, runFilesystemPure)+import Seihou.Engine.Diff (computeDiff)+import Seihou.Engine.Execute (dryRunPlan, executePlan)+import Seihou.Engine.Plan (compilePlan)+import Seihou.Manifest.Types (emptyManifest)+import System.Directory (getCurrentDirectory)+import System.FilePath ((</>))+import Test.Hspec+import Test.Tasty+import Test.Tasty.Hspec (testSpec)++tests :: IO TestTree+tests = testSpec "Seihou.Integration.Execution" spec++fixedTime :: UTCTime+fixedTime = parseTimeOrError True defaultTimeLocale "%Y-%m-%dT%H:%M:%SZ" "2026-03-01T10:30:00Z"++fixtureDir :: IO FilePath+fixtureDir = do+  cwd <- getCurrentDirectory+  pure (cwd </> "test" </> "fixtures")++-- | Helper to extract the resolved variable values map.+resolvedValues :: Map.Map VarName ResolvedVar -> Map.Map VarName VarValue+resolvedValues = Map.map (.value)++-- | Load haskell-base fixture, resolve vars, compile plan.+compileFixturePlan :: [(Text, Text)] -> IO (Module, [Operation])+compileFixturePlan vars = do+  fixtures <- fixtureDir+  result <- loadModule [fixtures] "haskell-base"+  case result of+    Left err -> error ("Failed to load module: " <> show err)+    Right modul -> do+      let cli = Map.fromList [(VarName k, v) | (k, v) <- vars]+          env = Map.empty+      case resolveVariables (modul.vars) cli env "" "" Map.empty Map.empty Map.empty Map.empty Map.empty of+        Left errs -> error ("Failed to resolve: " <> show errs)+        Right resolved -> do+          planResult <- compilePlan (fixtures </> "haskell-base") modul (resolvedValues resolved)+          case planResult of+            Left errs -> error ("Plan failed: " <> show errs)+            Right ops -> pure (modul, ops)++-- | Helper to create a manifest with file records (avoids ambiguous record update).+manifestWithFiles :: UTCTime -> Map.Map FilePath FileRecord -> Manifest+manifestWithFiles t recs =+  let base = emptyManifest t+   in Manifest+        { version = base.version,+          genAt = base.genAt,+          modules = base.modules,+          vars = base.vars,+          files = recs+        }++-- | Extract planned files from operations for computeDiff.+extractPlanned :: ModuleName -> [Operation] -> [(FilePath, Text, ModuleName, Maybe PatchOp)]+extractPlanned modName' ops =+  [(dest, content, modName', Nothing) | WriteFileOp dest content _ <- ops]+    ++ [(dest, content, mName, Just pOp) | PatchFileOp dest content pOp _ mName <- ops]++spec :: Spec+spec = do+  describe "full execution pipeline" $ do+    it "first run creates files and builds file records" $ do+      (modul, ops) <- compileFixturePlan [("project.name", "my-app")]+      let modName = modul.name+          (records, fs) =+            runPureEff $+              runFilesystemPure emptyFS $+                executePlan "" ops Map.empty modName fixedTime+      -- Verify files were created in the filesystem+      Map.member "README.md" (fs.files) `shouldBe` True+      Map.member "my-app.cabal" (fs.files) `shouldBe` True+      Map.member "src/Lib.hs" (fs.files) `shouldBe` True+      Map.member "LICENSE" (fs.files) `shouldBe` True+      Map.member "cabal.project" (fs.files) `shouldBe` True+      -- Verify FileRecords for manifest+      Map.member "README.md" records `shouldBe` True+      Map.member "my-app.cabal" records `shouldBe` True+      Map.member "src/Lib.hs" records `shouldBe` True+      -- Verify content+      Map.lookup "README.md" (fs.files) `shouldBe` Just "# my-app\n\nVersion: 0.1.0.0\n"++    it "re-run with same plan shows all unchanged" $ do+      (modul, ops) <- compileFixturePlan [("project.name", "my-app")]+      let modName = modul.name+          planned = extractPlanned modName ops+          -- First run: execute to get filesystem state and records+          (records, fs) =+            runPureEff $+              runFilesystemPure emptyFS $+                executePlan "" ops Map.empty modName fixedTime+          -- Build manifest from first run+          manifest = manifestWithFiles fixedTime records+          -- Re-run: compute diff against same plan and same FS+          (diff, _) =+            runPureEff $+              runFilesystemPure fs $+                computeDiff manifest (Set.singleton modName) planned+      -- All files should be unchanged+      length (diff.new) `shouldBe` 0+      length (diff.modified) `shouldBe` 0+      length (diff.conflicts) `shouldBe` 0+      length (diff.orphaned) `shouldBe` 0+      length (diff.unchanged) `shouldBe` 5++    it "re-run with changed variable shows modified, new, and orphaned" $ do+      (modul, ops1) <- compileFixturePlan [("project.name", "my-app")]+      let modName = modul.name+          -- First run+          (records, fs) =+            runPureEff $+              runFilesystemPure emptyFS $+                executePlan "" ops1 Map.empty modName fixedTime+          manifest = manifestWithFiles fixedTime records+      -- Compile with changed variable+      (_, ops2) <- compileFixturePlan [("project.name", "other-app")]+      let planned2 = extractPlanned modName ops2+          (diff, _) =+            runPureEff $+              runFilesystemPure fs $+                computeDiff manifest (Set.singleton modName) planned2+      -- README.md and cabal.project have different content → Modified+      length (diff.modified) `shouldBe` 2+      -- src/Lib.hs and LICENSE have same content → Unchanged+      length (diff.unchanged) `shouldBe` 2+      -- my-app.cabal not in new plan → Orphaned+      length (diff.orphaned) `shouldBe` 1+      (head diff.orphaned).path `shouldBe` "my-app.cabal"+      -- other-app.cabal is new → New+      length (diff.new) `shouldBe` 1+      (head diff.new).path `shouldBe` "other-app.cabal"+      -- No conflicts+      length (diff.conflicts) `shouldBe` 0++    it "dryRunPlan lists all operations without execution" $ do+      (_, ops) <- compileFixturePlan [("project.name", "my-app")]+      let text = dryRunPlan ops+      T.isInfixOf "README.md" text `shouldBe` True+      T.isInfixOf "my-app.cabal" text `shouldBe` True+      T.isInfixOf "cabal.project" text `shouldBe` True++    it "force mode: re-execute after user edit overwrites the file" $ do+      (modul, ops) <- compileFixturePlan [("project.name", "my-app")]+      let modName = modul.name+          planned = extractPlanned modName ops+          -- First run+          (records, fs1) =+            runPureEff $+              runFilesystemPure emptyFS $+                executePlan "" ops Map.empty modName fixedTime+          manifest = manifestWithFiles fixedTime records+          -- Simulate user editing README.md+          fs2 = PureFS (Map.insert "README.md" "user edit" fs1.files) fs1.dirs+          -- Compute diff → should detect conflict+          (diff, _) =+            runPureEff $+              runFilesystemPure fs2 $+                computeDiff manifest (Set.singleton modName) planned+      -- README.md is a conflict (user edited, plan unchanged)+      length (diff.conflicts) `shouldBe` 1+      (head diff.conflicts).path `shouldBe` "README.md"+      -- Force: re-execute (overwrites user changes)+      let (_, fs3) =+            runPureEff $+              runFilesystemPure fs2 $+                executePlan "" ops Map.empty modName fixedTime+      -- Verify README.md was overwritten with plan content+      Map.lookup "README.md" fs3.files `shouldBe` Just "# my-app\n\nVersion: 0.1.0.0\n"++    it "records correct strategy per file in FileRecords" $ do+      (modul, ops) <- compileFixturePlan [("project.name", "my-app")]+      let modName = modul.name+          (records, _) =+            runPureEff $+              runFilesystemPure emptyFS $+                executePlan "" ops Map.empty modName fixedTime+      -- README.md → Template+      (records Map.! "README.md").strategy `shouldBe` Template+      -- src/Lib.hs → Template+      (records Map.! "src/Lib.hs").strategy `shouldBe` Template+      -- LICENSE → Copy+      (records Map.! "LICENSE").strategy `shouldBe` Copy+      -- my-app.cabal → Template+      (records Map.! "my-app.cabal").strategy `shouldBe` Template+      -- cabal.project → DhallText+      (records Map.! "cabal.project").strategy `shouldBe` DhallText
+ test/Seihou/Integration/GenerationSpec.hs view
@@ -0,0 +1,146 @@+module Seihou.Integration.GenerationSpec (tests) where++import Data.Map.Strict qualified as Map+import Data.Text qualified as T+import Seihou.Core.Module (loadModule)+import Seihou.Core.Types+import Seihou.Core.Variable (resolveVariables)+import Seihou.Engine.Plan (compilePlan)+import System.Directory (getCurrentDirectory)+import System.FilePath ((</>))+import Test.Hspec+import Test.Tasty+import Test.Tasty.Hspec (testSpec)++tests :: IO TestTree+tests = testSpec "Seihou.Integration.Generation" spec++fixtureDir :: IO FilePath+fixtureDir = do+  cwd <- getCurrentDirectory+  pure (cwd </> "test" </> "fixtures")++-- | Helper to extract the resolved variable values map.+resolvedValues :: Map.Map VarName ResolvedVar -> Map.Map VarName VarValue+resolvedValues = Map.map (.value)++spec :: Spec+spec = do+  describe "full pipeline: load, resolve, compile" $ do+    it "produces correct README.md content" $ do+      fixtures <- fixtureDir+      result <- loadModule [fixtures] "haskell-base"+      case result of+        Left err -> expectationFailure ("Failed to load module: " <> show err)+        Right modul -> do+          let cli = Map.fromList [("project.name", "my-app")]+              env = Map.empty+          case resolveVariables (modul.vars) cli env "" "" Map.empty Map.empty Map.empty Map.empty Map.empty of+            Left errs -> expectationFailure ("Failed to resolve: " <> show errs)+            Right resolved -> do+              planResult <- compilePlan (fixtures </> "haskell-base") modul (resolvedValues resolved)+              case planResult of+                Left errs -> expectationFailure ("Plan failed: " <> show errs)+                Right ops -> do+                  let readmeOps = [op | op@(WriteFileOp d _ _) <- ops, d == "README.md"]+                  length readmeOps `shouldBe` 1+                  let (WriteFileOp _ content _) = readmeOps !! 0+                  content `shouldBe` "# my-app\n\nVersion: 0.1.0.0\n"++    it "produces correct cabal file with expanded destination" $ do+      fixtures <- fixtureDir+      result <- loadModule [fixtures] "haskell-base"+      case result of+        Left err -> expectationFailure ("Failed to load module: " <> show err)+        Right modul -> do+          let cli = Map.fromList [("project.name", "my-app")]+              env = Map.empty+          case resolveVariables (modul.vars) cli env "" "" Map.empty Map.empty Map.empty Map.empty Map.empty of+            Left errs -> expectationFailure ("Failed to resolve: " <> show errs)+            Right resolved -> do+              planResult <- compilePlan (fixtures </> "haskell-base") modul (resolvedValues resolved)+              case planResult of+                Left errs -> expectationFailure ("Plan failed: " <> show errs)+                Right ops -> do+                  let cabalOps = [op | op@(WriteFileOp d _ _) <- ops, d == "my-app.cabal"]+                  length cabalOps `shouldBe` 1+                  let (WriteFileOp _ content _) = cabalOps !! 0+                  T.isInfixOf "name: my-app" content `shouldBe` True+                  T.isInfixOf "version: 0.1.0.0" content `shouldBe` True+                  T.isInfixOf "license: MIT" content `shouldBe` True++    it "includes LICENSE step when license is set" $ do+      fixtures <- fixtureDir+      result <- loadModule [fixtures] "haskell-base"+      case result of+        Left err -> expectationFailure ("Failed to load module: " <> show err)+        Right modul -> do+          let cli = Map.fromList [("project.name", "my-app")]+              env = Map.empty+          case resolveVariables (modul.vars) cli env "" "" Map.empty Map.empty Map.empty Map.empty Map.empty of+            Left errs -> expectationFailure ("Failed to resolve: " <> show errs)+            Right resolved -> do+              planResult <- compilePlan (fixtures </> "haskell-base") modul (resolvedValues resolved)+              case planResult of+                Left errs -> expectationFailure ("Plan failed: " <> show errs)+                Right ops -> do+                  let licenseOps = [op | op@(WriteFileOp d _ _) <- ops, d == "LICENSE"]+                  length licenseOps `shouldBe` 1++    it "excludes LICENSE step when license is not set" $ do+      fixtures <- fixtureDir+      result <- loadModule [fixtures] "haskell-base"+      case result of+        Left err -> expectationFailure ("Failed to load module: " <> show err)+        Right modul -> do+          -- Provide all vars but use an empty var map for IsSet evaluation.+          -- The real scenario: license has a default so it's always set.+          -- To test the conditional, we use a stripped-down module with only the LICENSE step.+          let licenseStep = Step Copy "LICENSE" "LICENSE" (Just (ExprIsSet "license")) Nothing+              smallModule = modul {steps = [licenseStep]}+              vars = Map.empty -- no license variable set+          planResult <- compilePlan (fixtures </> "haskell-base") smallModule vars+          case planResult of+            Left errs -> expectationFailure ("Plan failed: " <> show errs)+            Right ops -> do+              let licenseOps = [op | op@(WriteFileOp d _ _) <- ops, d == "LICENSE"]+              length licenseOps `shouldBe` 0++    it "produces DhallText output for cabal.project" $ do+      fixtures <- fixtureDir+      result <- loadModule [fixtures] "haskell-base"+      case result of+        Left err -> expectationFailure ("Failed to load module: " <> show err)+        Right modul -> do+          let cli = Map.fromList [("project.name", "my-app")]+              env = Map.empty+          case resolveVariables (modul.vars) cli env "" "" Map.empty Map.empty Map.empty Map.empty Map.empty of+            Left errs -> expectationFailure ("Failed to resolve: " <> show errs)+            Right resolved -> do+              planResult <- compilePlan (fixtures </> "haskell-base") modul (resolvedValues resolved)+              case planResult of+                Left errs -> expectationFailure ("Plan failed: " <> show errs)+                Right ops -> do+                  let projectOps = [op | op@(WriteFileOp d _ _) <- ops, d == "cabal.project"]+                  length projectOps `shouldBe` 1+                  let (WriteFileOp _ content _) = projectOps !! 0+                  T.isInfixOf "my-app" content `shouldBe` True++    it "resolves variables from env and applies precedence" $ do+      fixtures <- fixtureDir+      result <- loadModule [fixtures] "haskell-base"+      case result of+        Left err -> expectationFailure ("Failed to load module: " <> show err)+        Right modul -> do+          -- CLI overrides project.name, env overrides license+          let cli = Map.fromList [("project.name", "cli-app")]+              env = Map.fromList [("SEIHOU_VAR_LICENSE", "BSD3")]+          case resolveVariables (modul.vars) cli env "" "" Map.empty Map.empty Map.empty Map.empty Map.empty of+            Left errs -> expectationFailure ("Failed to resolve: " <> show errs)+            Right resolved -> do+              (.value) (resolved Map.! "project.name") `shouldBe` VText "cli-app"+              (.source) (resolved Map.! "project.name") `shouldBe` FromCLI+              (.value) (resolved Map.! "license") `shouldBe` VText "BSD3"+              (.source) (resolved Map.! "license") `shouldBe` FromEnv "SEIHOU_VAR_LICENSE"+              (.value) (resolved Map.! "project.version") `shouldBe` VText "0.1.0.0"+              (.source) (resolved Map.! "project.version") `shouldBe` FromDefault
+ test/Seihou/Integration/ModuleLoadSpec.hs view
@@ -0,0 +1,118 @@+module Seihou.Integration.ModuleLoadSpec (tests) where++import Data.Map.Strict qualified as Map+import Effectful+-- Re-use the real loader for end-to-end tests+import Seihou.Core.Module (loadModule)+import Seihou.Core.Types+import Seihou.Effect.DhallEval (evalModuleFile)+import Seihou.Effect.DhallEvalInterp (runDhallEvalPure)+import System.Directory (getCurrentDirectory)+import System.FilePath ((</>))+import Test.Hspec+import Test.Tasty+import Test.Tasty.Hspec (testSpec)++tests :: IO TestTree+tests = testSpec "Seihou.Integration.ModuleLoad" spec++fixtureDir :: IO FilePath+fixtureDir = do+  cwd <- getCurrentDirectory+  pure (cwd </> "test" </> "fixtures")++spec :: Spec+spec = do+  describe "haskell-base end-to-end" $ do+    it "loads with correct name, vars, steps, and prompt" $ do+      fixtures <- fixtureDir+      result <- loadModule [fixtures] "haskell-base"+      case result of+        Left err -> expectationFailure ("Expected Right, got: " <> show err)+        Right m -> do+          m.name `shouldBe` "haskell-base"+          m.description `shouldBe` Just "A Haskell project template"+          length (m.vars) `shouldBe` 3+          length (m.steps) `shouldBe` 5+          length (m.prompts) `shouldBe` 1+          m.dependencies `shouldBe` []++    it "has correct variable declarations" $ do+      fixtures <- fixtureDir+      result <- loadModule [fixtures] "haskell-base"+      case result of+        Left err -> expectationFailure ("Expected Right, got: " <> show err)+        Right m -> do+          let vars = m.vars+          let names = map ((.unVarName) . (.name)) vars+          names `shouldBe` ["project.name", "project.version", "license"]++          let (projectName : projectVersion : license : _) = vars+          projectName.required `shouldBe` True+          projectName.default_ `shouldBe` Nothing++          projectVersion.default_ `shouldBe` Just (VText "0.1.0.0")++          license.default_ `shouldBe` Just (VText "MIT")++    it "has a when expression on the LICENSE step" $ do+      fixtures <- fixtureDir+      result <- loadModule [fixtures] "haskell-base"+      case result of+        Left err -> expectationFailure ("Expected Right, got: " <> show err)+        Right m -> do+          let steps = m.steps+          let licenseStep = steps !! 2+          licenseStep.strategy `shouldBe` Copy+          licenseStep.condition `shouldBe` Just (ExprIsSet "license")++    it "has a dest with placeholder variable" $ do+      fixtures <- fixtureDir+      result <- loadModule [fixtures] "haskell-base"+      case result of+        Left err -> expectationFailure ("Expected Right, got: " <> show err)+        Right m -> do+          let cabalStep = m.steps !! 3+          cabalStep.dest `shouldBe` "{{project.name}}.cabal"++  describe "invalid-module" $ do+    it "produces ValidationError with multiple violations" $ do+      fixtures <- fixtureDir+      result <- loadModule [fixtures] "invalid-module"+      case result of+        Left (ValidationError _ errs) -> do+          length errs `shouldSatisfy` (>= 4)+        Left other -> expectationFailure ("Expected ValidationError, got: " <> show other)+        Right _ -> expectationFailure "Expected validation failure"++  describe "nonexistent module" $ do+    it "produces ModuleNotFound" $ do+      result <- loadModule ["/nonexistent"] "no-such-module"+      case result of+        Left (ModuleNotFound name _) ->+          name.unModuleName `shouldBe` "no-such-module"+        Left other -> expectationFailure ("Expected ModuleNotFound, got: " <> show other)+        Right _ -> expectationFailure "Expected Left"++  describe "pure DhallEval interpreter" $ do+    it "returns modules from the in-memory map" $ do+      let testModule =+            Module+              { name = "test",+                version = Nothing,+                description = Nothing,+                vars = [],+                exports = [],+                prompts = [],+                steps = [],+                commands = [],+                dependencies = [],+                removal = Nothing,+                migrations = []+              }+          modules = Map.fromList [("test/module.dhall", testModule)]+      result <- runEff $ runDhallEvalPure modules $ do+        evalModuleFile "test/module.dhall"+      case result of+        Left err -> expectationFailure ("Expected Right, got: " <> show err)+        Right m -> m.name `shouldBe` "test"
+ test/Seihou/Interaction/ConfirmSpec.hs view
@@ -0,0 +1,172 @@+module Seihou.Interaction.ConfirmSpec (tests) where++import Data.Map.Strict qualified as Map+import Effectful+import Seihou.Composition.Instance (primaryInstance)+import Seihou.Core.Types+import Seihou.Effect.ConsolePure+import Seihou.Interaction.Confirm (confirmDefaults)+import Test.Hspec+import Test.Tasty+import Test.Tasty.Hspec (testSpec)++tests :: IO TestTree+tests = testSpec "Seihou.Interaction.Confirm" spec++mkModule :: ModuleName -> [VarDecl] -> [Prompt] -> Module+mkModule name vars prompts =+  Module+    { name = name,+      version = Nothing,+      description = Nothing,+      vars = vars,+      exports = [],+      prompts = prompts,+      steps = [],+      commands = [],+      dependencies = [],+      removal = Nothing,+      migrations = []+    }++mkTextVar :: VarName -> Maybe VarValue -> VarDecl+mkTextVar name defVal =+  VarDecl+    { name = name,+      type_ = VTText,+      default_ = defVal,+      description = Nothing,+      required = True,+      validation = Nothing+    }++mkIntVar :: VarName -> Maybe VarValue -> VarDecl+mkIntVar name defVal =+  VarDecl+    { name = name,+      type_ = VTInt,+      default_ = defVal,+      description = Nothing,+      required = True,+      validation = Nothing+    }++mkResolved :: VarDecl -> VarValue -> VarSource -> ResolvedVar+mkResolved decl val src =+  ResolvedVar {value = val, source = src, decl = decl}++spec :: Spec+spec = do+  describe "confirmDefaults" $ do+    it "does nothing when the flag activates but no variables have default sources" $ do+      let decl = mkTextVar "project.name" (Just (VText "my-project"))+          m = mkModule "base" [decl] []+          resolved =+            Map.singleton+              (primaryInstance "base")+              (Map.singleton "project.name" (mkResolved decl (VText "my-app") FromCLI))+      (result, st) <-+        runEff $+          runConsolePure [] $+            confirmDefaults [(primaryInstance m.name, m, "/fake/base")] resolved+      result `shouldBe` resolved+      st.consoleOutputs `shouldSatisfy` all (/= "Confirm default values:")++    it "prompts for FromDefault variables and accepts Enter as keeping the default" $ do+      let decl = mkTextVar "project.version" (Just (VText "0.1.0.0"))+          m = mkModule "base" [decl] []+          resolved =+            Map.singleton+              (primaryInstance "base")+              (Map.singleton "project.version" (mkResolved decl (VText "0.1.0.0") FromDefault))+      (result, st) <-+        runEff $+          runConsolePure [""] $+            confirmDefaults [(primaryInstance m.name, m, "/fake/base")] resolved+      let rv = (result Map.! primaryInstance "base") Map.! "project.version"+      rv.value `shouldBe` VText "0.1.0.0"+      rv.source `shouldBe` FromDefault+      st.consoleOutputs `shouldSatisfy` any (== "Confirm default values:")+      st.consoleOutputs `shouldSatisfy` any (== "project.version [0.1.0.0]:")++    it "replaces the value and marks source as FromPrompt when user types a new value" $ do+      let decl = mkTextVar "project.version" (Just (VText "0.1.0.0"))+          m = mkModule "base" [decl] []+          resolved =+            Map.singleton+              (primaryInstance "base")+              (Map.singleton "project.version" (mkResolved decl (VText "0.1.0.0") FromDefault))+      (result, _st) <-+        runEff $+          runConsolePure ["1.0.0"] $+            confirmDefaults [(primaryInstance m.name, m, "/fake/base")] resolved+      let rv = (result Map.! primaryInstance "base") Map.! "project.version"+      rv.value `shouldBe` VText "1.0.0"+      rv.source `shouldBe` FromPrompt++    it "retries on invalid input and keeps the default on final failure" $ do+      let decl = mkIntVar "retry.count" (Just (VInt 42))+          m = mkModule "base" [decl] []+          resolved =+            Map.singleton+              (primaryInstance "base")+              (Map.singleton "retry.count" (mkResolved decl (VInt 42) FromDefault))+      (result, _st) <-+        runEff $+          runConsolePure ["not-an-int", "still-bad", "nope"] $+            confirmDefaults [(primaryInstance m.name, m, "/fake/base")] resolved+      let rv = (result Map.! primaryInstance "base") Map.! "retry.count"+      rv.value `shouldBe` VInt 42+      rv.source `shouldBe` FromDefault++    it "prompts for FromParent variables" $ do+      let decl = mkTextVar "skill.name" (Just (VText "exec-plan"))+          m = mkModule "child" [decl] []+          resolved =+            Map.singleton+              (primaryInstance "child")+              ( Map.singleton+                  "skill.name"+                  (mkResolved decl (VText "exec-plan") (FromParent "parent"))+              )+      (result, _st) <-+        runEff $+          runConsolePure ["override"] $+            confirmDefaults [(primaryInstance m.name, m, "/fake/child")] resolved+      let rv = (result Map.! primaryInstance "child") Map.! "skill.name"+      rv.value `shouldBe` VText "override"+      rv.source `shouldBe` FromPrompt++    it "is a no-op in non-interactive mode" $ do+      let decl = mkTextVar "project.version" (Just (VText "0.1.0.0"))+          m = mkModule "base" [decl] []+          resolved =+            Map.singleton+              (primaryInstance "base")+              (Map.singleton "project.version" (mkResolved decl (VText "0.1.0.0") FromDefault))+      (result, st) <-+        runEff $+          runConsolePureNonInteractive $+            confirmDefaults [(primaryInstance m.name, m, "/fake/base")] resolved+      result `shouldBe` resolved+      st.consoleOutputs `shouldBe` []++    it "uses authored Prompt text when available" $ do+      let decl = mkTextVar "license" (Just (VText "MIT"))+          prompt =+            Prompt+              { var = "license",+                text = "Choose a license",+                condition = Nothing,+                choices = Nothing+              }+          m = mkModule "base" [decl] [prompt]+          resolved =+            Map.singleton+              (primaryInstance "base")+              (Map.singleton "license" (mkResolved decl (VText "MIT") FromDefault))+      (_result, st) <-+        runEff $+          runConsolePure [""] $+            confirmDefaults [(primaryInstance m.name, m, "/fake/base")] resolved+      st.consoleOutputs `shouldSatisfy` any (== "Choose a license [MIT]:")
+ test/Seihou/Interaction/PromptSpec.hs view
@@ -0,0 +1,502 @@+module Seihou.Interaction.PromptSpec (tests) where++import Data.Map.Strict qualified as Map+import Data.Text (Text)+import Effectful+import Seihou.Composition.Instance (primaryInstance)+import Seihou.Composition.Resolve (resolveWithPrompts)+import Seihou.Core.Types+import Seihou.Effect.ConsolePure+import Seihou.Interaction.Prompt (promptForVar, runPrompts)+import Test.Hspec+import Test.Tasty+import Test.Tasty.Hspec (testSpec)++tests :: IO TestTree+tests = testSpec "Seihou.Interaction.Prompt" spec++-- | Helper to create a minimal module.+mkModule :: ModuleName -> [ModuleName] -> [VarDecl] -> [VarExport] -> [Prompt] -> Module+mkModule name deps vars exports prompts =+  Module+    { name = name,+      version = Nothing,+      description = Nothing,+      vars = vars,+      exports = exports,+      prompts = prompts,+      steps = [],+      commands = [],+      dependencies = map simpleDep deps,+      removal = Nothing,+      migrations = []+    }++-- | Helper to create a text variable declaration.+mkTextVar :: VarName -> Maybe VarValue -> Bool -> VarDecl+mkTextVar name defVal required =+  VarDecl+    { name = name,+      type_ = VTText,+      default_ = defVal,+      description = Nothing,+      required = required,+      validation = Nothing+    }++-- | Helper to create a bool variable declaration.+mkBoolVar :: VarName -> Maybe VarValue -> Bool -> VarDecl+mkBoolVar name defVal required =+  VarDecl+    { name = name,+      type_ = VTBool,+      default_ = defVal,+      description = Nothing,+      required = required,+      validation = Nothing+    }++-- | Helper to create a simple prompt for a variable.+mkPrompt :: VarName -> Text -> Prompt+mkPrompt var text =+  Prompt+    { var = var,+      text = text,+      condition = Nothing,+      choices = Nothing+    }++-- | Helper to create a prompt with choices.+mkChoicePrompt :: VarName -> Text -> [Text] -> Prompt+mkChoicePrompt var text choices =+  Prompt+    { var = var,+      text = text,+      condition = Nothing,+      choices = Just choices+    }++-- | Helper to create a prompt with a when condition.+mkConditionalPrompt :: VarName -> Text -> Expr -> Prompt+mkConditionalPrompt var text expr =+  Prompt+    { var = var,+      text = text,+      condition = Just expr,+      choices = Nothing+    }++-- | Helper to create an export without alias.+mkExport :: VarName -> VarExport+mkExport name = VarExport {var = name, alias = Nothing}++spec :: Spec+spec = do+  describe "runPrompts" $ do+    it "fills a required text variable with FromPrompt source" $ do+      let decl = mkTextVar "project.name" Nothing True+          prompt = mkPrompt "project.name" "What is the project name?"+          bindings = Map.empty+      (result, st) <-+        runEff $+          runConsolePure ["my-app"] $+            runPrompts [prompt] [decl] bindings+      Map.member "project.name" result `shouldBe` True+      let rv = result Map.! "project.name"+      rv.value `shouldBe` VText "my-app"+      rv.source `shouldBe` FromPrompt+      -- The prompt text should have been output+      st.consoleOutputs `shouldSatisfy` any (== "What is the project name?")++    it "fills a prompt with choices via selection number" $ do+      let decl = mkTextVar "license" Nothing True+          prompt = mkChoicePrompt "license" "Choose a license:" ["MIT", "Apache-2.0", "BSD-3-Clause"]+          bindings = Map.empty+      (result, _st) <-+        runEff $+          runConsolePure ["2"] $+            runPrompts [prompt] [decl] bindings+      Map.member "license" result `shouldBe` True+      (result Map.! "license").value `shouldBe` VText "Apache-2.0"+      (result Map.! "license").source `shouldBe` FromPrompt++    it "skips a prompt whose when condition evaluates to False" $ do+      let decl = mkTextVar "extra.flag" Nothing True+          -- Condition: IsSet license — but license is not in bindings+          prompt = mkConditionalPrompt "extra.flag" "Extra flag?" (ExprIsSet "license")+          bindings = Map.empty+      (result, st) <-+        runEff $+          runConsolePure ["some-value"] $+            runPrompts [prompt] [decl] bindings+      -- Prompt was skipped, so the variable is not resolved+      Map.member "extra.flag" result `shouldBe` False+      -- No prompt text was output+      st.consoleOutputs `shouldSatisfy` all (/= "Extra flag?")++    it "shows a prompt whose when condition evaluates to True" $ do+      let decl = mkTextVar "extra.flag" Nothing True+          -- Condition: IsSet license — license IS in bindings+          prompt = mkConditionalPrompt "extra.flag" "Extra flag?" (ExprIsSet "license")+          bindings = Map.singleton "license" (VText "MIT")+      (result, _st) <-+        runEff $+          runConsolePure ["some-value"] $+            runPrompts [prompt] [decl] bindings+      Map.member "extra.flag" result `shouldBe` True+      (result Map.! "extra.flag").value `shouldBe` VText "some-value"++    it "skips a prompt for a variable not in the unresolved set" $ do+      let decl = mkTextVar "project.name" Nothing True+          -- Prompt references a different variable+          prompt = mkPrompt "other.var" "Other?"+          bindings = Map.empty+      (result, st) <-+        runEff $+          runConsolePure ["anything"] $+            runPrompts [prompt] [decl] bindings+      Map.null result `shouldBe` True+      st.consoleOutputs `shouldSatisfy` all (/= "Other?")++  describe "default value display" $ do+    it "shows default value in prompt text and accepts Enter" $ do+      let decl = mkTextVar "project.version" (Just (VText "0.1.0.0")) True+          prompt = mkPrompt "project.version" "Project version"+      (result, st) <-+        runEff $+          runConsolePure [""] $+            promptForVar prompt decl Map.empty+      case result of+        Left err -> expectationFailure $ "Expected Right, got: " ++ show err+        Right rv -> do+          rv.value `shouldBe` VText "0.1.0.0"+          rv.source `shouldBe` FromPrompt+      -- Prompt text should include the default in brackets+      st.consoleOutputs `shouldSatisfy` any (== "Project version [0.1.0.0]:")++    it "accepts user input over default when provided" $ do+      let decl = mkTextVar "project.version" (Just (VText "0.1.0.0")) True+          prompt = mkPrompt "project.version" "Project version"+      (result, st) <-+        runEff $+          runConsolePure ["1.0.0"] $+            promptForVar prompt decl Map.empty+      case result of+        Left err -> expectationFailure $ "Expected Right, got: " ++ show err+        Right rv ->+          rv.value `shouldBe` VText "1.0.0"+      st.consoleOutputs `shouldSatisfy` any (== "Project version [0.1.0.0]:")++    it "shows [skip] for optional variable without default" $ do+      let decl = mkTextVar "license" Nothing False+          prompt = mkPrompt "license" "License"+      (_result, st) <-+        runEff $+          runConsolePure [""] $+            promptForVar prompt decl Map.empty+      st.consoleOutputs `shouldSatisfy` any (== "License [skip]:")++    it "shows bool default as yes/no" $ do+      let decl = mkBoolVar "enable.ci" (Just (VBool True)) False+          prompt = mkPrompt "enable.ci" "Enable CI?"+      (result, st) <-+        runEff $+          runConsolePure [""] $+            promptForVar prompt decl Map.empty+      case result of+        Left err -> expectationFailure $ "Expected Right, got: " ++ show err+        Right rv ->+          rv.value `shouldBe` VBool True+      st.consoleOutputs `shouldSatisfy` any (== "Enable CI? [yes]:")++  describe "promptForVar" $ do+    it "coerces boolean input correctly" $ do+      let decl = mkBoolVar "use.ci" Nothing True+          prompt = mkPrompt "use.ci" "Enable CI?"+      (result, _st) <-+        runEff $+          runConsolePure ["yes"] $+            promptForVar prompt decl Map.empty+      case result of+        Left err -> expectationFailure $ "Expected Right, got: " ++ show err+        Right rv -> do+          rv.value `shouldBe` VBool True+          rv.source `shouldBe` FromPrompt++    it "coerces 'no' to False for boolean variable" $ do+      let decl = mkBoolVar "use.ci" Nothing True+          prompt = mkPrompt "use.ci" "Enable CI?"+      (result, _st) <-+        runEff $+          runConsolePure ["no"] $+            promptForVar prompt decl Map.empty+      case result of+        Left err -> expectationFailure $ "Expected Right, got: " ++ show err+        Right rv ->+          rv.value `shouldBe` VBool False++    it "retries on empty input then succeeds" $ do+      let decl = mkTextVar "project.name" Nothing True+          prompt = mkPrompt "project.name" "Project name?"+      (result, st) <-+        runEff $+          runConsolePure ["", "my-app"] $+            promptForVar prompt decl Map.empty+      case result of+        Left err -> expectationFailure $ "Expected Right, got: " ++ show err+        Right rv ->+          rv.value `shouldBe` VText "my-app"+      -- Should have output a retry message+      st.consoleOutputs `shouldSatisfy` any (== "Value cannot be empty. Please try again.")++    it "fails after exhausting retries on empty input" $ do+      let decl = mkTextVar "project.name" Nothing True+          prompt = mkPrompt "project.name" "Project name?"+      (result, _st) <-+        runEff $+          runConsolePure ["", "", ""] $+            promptForVar prompt decl Map.empty+      case result of+        Left (MissingRequiredVar _) -> pure ()+        Left err -> expectationFailure $ "Expected MissingRequiredVar, got: " ++ show err+        Right _ -> expectationFailure "Expected Left, got Right"++  describe "resolveWithPrompts" $ do+    it "prompts for missing required variables in interactive mode" $ do+      let m =+            mkModule+              "base"+              []+              [mkTextVar "project.name" Nothing True]+              []+              [mkPrompt "project.name" "What is the project name?"]+          modules = [(primaryInstance m.name, m, "/fake/base")]+      (result, st) <-+        runEff $+          runConsolePure ["my-app"] $+            resolveWithPrompts modules Map.empty Map.empty "" "" Map.empty Map.empty Map.empty Map.empty+      case result of+        Left errs -> expectationFailure $ "Expected Right, got: " ++ show errs+        Right resolved -> do+          let baseVars = resolved Map.! primaryInstance "base"+          (baseVars Map.! "project.name").value `shouldBe` VText "my-app"+          (baseVars Map.! "project.name").source `shouldBe` FromPrompt+      st.consoleOutputs `shouldSatisfy` any (== "What is the project name?")++    it "does not prompt when all variables are provided via CLI" $ do+      let m =+            mkModule+              "base"+              []+              [mkTextVar "project.name" Nothing True]+              []+              [mkPrompt "project.name" "What is the project name?"]+          modules = [(primaryInstance m.name, m, "/fake/base")]+          cliOverrides = Map.singleton "project.name" "from-cli"+      (result, st) <-+        runEff $+          runConsolePure [] $+            resolveWithPrompts modules cliOverrides Map.empty "" "" Map.empty Map.empty Map.empty Map.empty+      case result of+        Left errs -> expectationFailure $ "Expected Right, got: " ++ show errs+        Right resolved -> do+          let baseVars = resolved Map.! primaryInstance "base"+          (baseVars Map.! "project.name").value `shouldBe` VText "from-cli"+          (baseVars Map.! "project.name").source `shouldBe` FromCLI+      -- No prompts should have been displayed+      st.consoleOutputs `shouldSatisfy` all (/= "What is the project name?")++    it "skips prompts and errors in non-interactive mode" $ do+      let m =+            mkModule+              "base"+              []+              [mkTextVar "project.name" Nothing True]+              []+              [mkPrompt "project.name" "What is the project name?"]+          modules = [(primaryInstance m.name, m, "/fake/base")]+      (result, st) <-+        runEff $+          runConsolePureNonInteractive $+            resolveWithPrompts modules Map.empty Map.empty "" "" Map.empty Map.empty Map.empty Map.empty+      case result of+        Left errs -> case errs of+          [MissingRequiredVar name] -> name `shouldBe` "project.name"+          [other] -> expectationFailure $ "Expected MissingRequiredVar, got: " ++ show other+          _ -> expectationFailure $ "Expected exactly 1 error, got: " ++ show (length errs)+        Right _ -> expectationFailure "Expected Left (errors), got Right"+      -- No prompts should have been displayed+      st.consoleOutputs `shouldSatisfy` all (/= "What is the project name?")++    it "prompts for optional variables after required resolution" $ do+      let m =+            mkModule+              "base"+              []+              [ mkTextVar "project.name" Nothing True,+                mkTextVar "license" Nothing False+              ]+              []+              [ mkPrompt "project.name" "What is the project name?",+                mkPrompt "license" "License"+              ]+          modules = [(primaryInstance m.name, m, "/fake/base")]+      (result, st) <-+        runEff $+          runConsolePure ["my-app", "MIT"] $+            resolveWithPrompts modules Map.empty Map.empty "" "" Map.empty Map.empty Map.empty Map.empty+      case result of+        Left errs -> expectationFailure $ "Expected Right, got: " ++ show errs+        Right resolved -> do+          let baseVars = resolved Map.! primaryInstance "base"+          (baseVars Map.! "project.name").value `shouldBe` VText "my-app"+          (baseVars Map.! "project.name").source `shouldBe` FromPrompt+          (baseVars Map.! "license").value `shouldBe` VText "MIT"+          (baseVars Map.! "license").source `shouldBe` FromPrompt+      st.consoleOutputs `shouldSatisfy` any (== "Optional configuration:")++    it "skips optional variable when user presses Enter" $ do+      let m =+            mkModule+              "base"+              []+              [ mkTextVar "project.name" Nothing True,+                mkTextVar "license" Nothing False+              ]+              []+              [ mkPrompt "project.name" "What is the project name?",+                mkPrompt "license" "License"+              ]+          modules = [(primaryInstance m.name, m, "/fake/base")]+      (result, _st) <-+        runEff $+          runConsolePure ["my-app", ""] $+            resolveWithPrompts modules Map.empty Map.empty "" "" Map.empty Map.empty Map.empty Map.empty+      case result of+        Left errs -> expectationFailure $ "Expected Right, got: " ++ show errs+        Right resolved -> do+          let baseVars = resolved Map.! primaryInstance "base"+          Map.member "project.name" baseVars `shouldBe` True+          Map.member "license" baseVars `shouldBe` False++    it "shows Optional configuration separator for optional-only modules" $ do+      let m =+            mkModule+              "base"+              []+              [mkTextVar "license" Nothing False]+              []+              [mkPrompt "license" "License"]+          modules = [(primaryInstance m.name, m, "/fake/base")]+      (result, st) <-+        runEff $+          runConsolePure ["MIT"] $+            resolveWithPrompts modules Map.empty Map.empty "" "" Map.empty Map.empty Map.empty Map.empty+      case result of+        Left errs -> expectationFailure $ "Expected Right, got: " ++ show errs+        Right resolved -> do+          let baseVars = resolved Map.! primaryInstance "base"+          (baseVars Map.! "license").value `shouldBe` VText "MIT"+      st.consoleOutputs `shouldSatisfy` any (== "Optional configuration:")++    it "does not show optional prompts in non-interactive mode" $ do+      let m =+            mkModule+              "base"+              []+              [mkTextVar "license" Nothing False]+              []+              [mkPrompt "license" "License"]+          modules = [(primaryInstance m.name, m, "/fake/base")]+      (result, st) <-+        runEff $+          runConsolePureNonInteractive $+            resolveWithPrompts modules Map.empty Map.empty "" "" Map.empty Map.empty Map.empty Map.empty+      case result of+        Left _ -> expectationFailure "Expected Right (no required vars)"+        Right resolved -> do+          let baseVars = resolved Map.! primaryInstance "base"+          Map.member "license" baseVars `shouldBe` False+      st.consoleOutputs `shouldSatisfy` all (/= "Optional configuration:")++    it "respects when condition on optional prompts" $ do+      let m =+            mkModule+              "base"+              []+              [ mkTextVar "project.name" Nothing True,+                mkTextVar "extra" Nothing False+              ]+              []+              [ mkPrompt "project.name" "Name?",+                mkConditionalPrompt "extra" "Extra?" (ExprIsSet "nonexistent")+              ]+          modules = [(primaryInstance m.name, m, "/fake/base")]+      (result, st) <-+        runEff $+          runConsolePure ["my-app"] $+            resolveWithPrompts modules Map.empty Map.empty "" "" Map.empty Map.empty Map.empty Map.empty+      case result of+        Left errs -> expectationFailure $ "Expected Right, got: " ++ show errs+        Right resolved -> do+          let baseVars = resolved Map.! primaryInstance "base"+          Map.member "extra" baseVars `shouldBe` False+      -- The condition was false so Optional configuration header should not appear+      -- (no optional prompts actually fired)+      st.consoleOutputs `shouldSatisfy` all (/= "Extra?")++    it "does not prompt for optional variables already resolved via config" $ do+      let m =+            mkModule+              "base"+              []+              [mkTextVar "license" Nothing False]+              []+              [mkPrompt "license" "License"]+          modules = [(primaryInstance m.name, m, "/fake/base")]+          globalConfig = Map.singleton "license" "MIT"+      (result, st) <-+        runEff $+          runConsolePure [] $+            resolveWithPrompts modules Map.empty Map.empty "" "" Map.empty Map.empty Map.empty globalConfig+      case result of+        Left errs -> expectationFailure $ "Expected Right, got: " ++ show errs+        Right resolved -> do+          let baseVars = resolved Map.! primaryInstance "base"+          (baseVars Map.! "license").value `shouldBe` VText "MIT"+          (baseVars Map.! "license").source `shouldBe` FromGlobalConfig+      st.consoleOutputs `shouldSatisfy` all (/= "Optional configuration:")++    it "flows prompted value from first module to second via exports" $ do+      let base =+            mkModule+              "base"+              []+              [mkTextVar "project.name" Nothing True]+              [mkExport "project.name"]+              [mkPrompt "project.name" "What is the project name?"]+          app =+            mkModule+              "app"+              ["base"]+              [mkTextVar "project.name" Nothing True]+              []+              []+          modules = [(primaryInstance base.name, base, "/fake/base"), (primaryInstance app.name, app, "/fake/app")]+      (result, st) <-+        runEff $+          runConsolePure ["my-app"] $+            resolveWithPrompts modules Map.empty Map.empty "" "" Map.empty Map.empty Map.empty Map.empty+      case result of+        Left errs -> expectationFailure $ "Expected Right, got: " ++ show errs+        Right resolved -> do+          -- Base module was prompted+          let baseVars = resolved Map.! primaryInstance "base"+          (baseVars Map.! "project.name").value `shouldBe` VText "my-app"+          (baseVars Map.! "project.name").source `shouldBe` FromPrompt+          -- App module received the value via export (no additional prompt needed)+          let appVars = resolved Map.! primaryInstance "app"+          (appVars Map.! "project.name").value `shouldBe` VText "my-app"+      -- Only one prompt should have fired (for base), not two+      let promptOutputs = filter (== "What is the project name?") (st.consoleOutputs)+      length promptOutputs `shouldBe` 1
+ test/Seihou/Manifest/TypesSpec.hs view
@@ -0,0 +1,339 @@+module Seihou.Manifest.TypesSpec (tests) where++import Data.Aeson qualified as Aeson+import Data.Map.Strict qualified as Map+import Data.Text qualified as T+import Data.Time (UTCTime, defaultTimeLocale, parseTimeOrError)+import Seihou.Core.Types+import Seihou.Manifest.Hash (hashContent)+import Seihou.Manifest.Types+import Test.Hspec+import Test.Tasty+import Test.Tasty.Hspec (testSpec)++tests :: IO TestTree+tests = testSpec "Seihou.Manifest.Types" spec++-- Helper to create a fixed timestamp for testing.+fixedTime :: UTCTime+fixedTime = parseTimeOrError True defaultTimeLocale "%Y-%m-%dT%H:%M:%SZ" "2026-03-01T10:30:00Z"++fixedTime2 :: UTCTime+fixedTime2 = parseTimeOrError True defaultTimeLocale "%Y-%m-%dT%H:%M:%SZ" "2026-03-01T11:00:00Z"++-- | Helper to set modules on a Manifest without ambiguous record update.+withManifestModules :: [AppliedModule] -> Manifest -> Manifest+withManifestModules mods m =+  Manifest m.version m.genAt mods m.vars m.files m.recipe m.blueprint++spec :: Spec+spec = do+  describe "emptyManifest" $ do+    it "creates a manifest with the current version" $ do+      let m = emptyManifest fixedTime+      m.version `shouldBe` currentManifestVersion+      m.version `shouldBe` 3++    it "creates a manifest with no modules, vars, or files" $ do+      let m = emptyManifest fixedTime+      m.modules `shouldBe` []+      m.vars `shouldBe` Map.empty+      m.files `shouldBe` Map.empty++  describe "JSON roundtrip" $ do+    it "roundtrips an empty manifest" $ do+      let m = emptyManifest fixedTime+      manifestFromJSON (manifestToJSON m) `shouldBe` Right m++    it "roundtrips a manifest with modules" $ do+      let m =+            withManifestModules+              [ AppliedModule+                  { name = ModuleName "haskell-base",+                    parentVars = emptyParentVars,+                    source = "/home/user/.config/seihou/modules/haskell-base",+                    moduleVersion = Nothing,+                    appliedAt = fixedTime,+                    removal = Nothing+                  }+              ]+              (emptyManifest fixedTime)+      manifestFromJSON (manifestToJSON m) `shouldBe` Right m++    it "roundtrips a manifest with variables" $ do+      let base = emptyManifest fixedTime+          m =+            Manifest+              { version = base.version,+                genAt = base.genAt,+                modules = base.modules,+                vars =+                  Map.fromList+                    [ (VarName "project.name", "my-app"),+                      (VarName "license", "MIT")+                    ],+                files = base.files,+                recipe = Nothing,+                blueprint = Nothing+              }+      manifestFromJSON (manifestToJSON m) `shouldBe` Right m++    it "roundtrips a manifest with file records" $ do+      let m :: Manifest+          m =+            (emptyManifest fixedTime)+              { files =+                  Map.fromList+                    [ ( "README.md",+                        FileRecord+                          { hash = SHA256 "abc123",+                            moduleName = ModuleName "haskell-base",+                            strategy = Template,+                            generatedAt = fixedTime+                          }+                      ),+                      ( "my-app.cabal",+                        FileRecord+                          { hash = SHA256 "def456",+                            moduleName = ModuleName "haskell-base",+                            strategy = DhallText,+                            generatedAt = fixedTime+                          }+                      )+                    ]+              }+      manifestFromJSON (manifestToJSON m) `shouldBe` Right m++    it "roundtrips a full manifest" $ do+      let m =+            Manifest+              { version = currentManifestVersion,+                genAt = fixedTime,+                modules =+                  [ AppliedModule (ModuleName "haskell-base") emptyParentVars "/path/to/module" Nothing fixedTime Nothing,+                    AppliedModule (ModuleName "nix-flake") emptyParentVars "/path/to/nix" Nothing fixedTime2 Nothing+                  ],+                vars =+                  Map.fromList+                    [ (VarName "project.name", "my-app"),+                      (VarName "project.version", "0.1.0.0")+                    ],+                files =+                  Map.fromList+                    [ ( "README.md",+                        FileRecord (SHA256 "aaa") (ModuleName "haskell-base") Template fixedTime+                      ),+                      ( "LICENSE",+                        FileRecord (SHA256 "bbb") (ModuleName "haskell-base") Copy fixedTime+                      )+                    ],+                recipe = Nothing,+                blueprint = Nothing+              }+      manifestFromJSON (manifestToJSON m) `shouldBe` Right m++    it "roundtrips all strategy types" $ do+      let strategies = [Copy, Template, DhallText, Structured]+          makeRecord s =+            FileRecord (SHA256 "hash") (ModuleName "mod") s fixedTime+          m :: Manifest+          m =+            (emptyManifest fixedTime)+              { files =+                  Map.fromList+                    (zipWith (\i s -> ("file" <> show i, makeRecord s)) [(1 :: Int) ..] strategies)+              }+      manifestFromJSON (manifestToJSON m) `shouldBe` Right m++    it "roundtrips a manifest with versioned modules" $ do+      let m =+            withManifestModules+              [ AppliedModule+                  { name = ModuleName "haskell-base",+                    parentVars = emptyParentVars,+                    source = "/path/to/module",+                    moduleVersion = Just "1.0.0",+                    appliedAt = fixedTime,+                    removal = Nothing+                  }+              ]+              (emptyManifest fixedTime)+      manifestFromJSON (manifestToJSON m) `shouldBe` Right m++    it "roundtrips a manifest with unversioned modules" $ do+      let m =+            withManifestModules+              [ AppliedModule+                  { name = ModuleName "simple-mod",+                    parentVars = emptyParentVars,+                    source = "/path/to/mod",+                    moduleVersion = Nothing,+                    appliedAt = fixedTime,+                    removal = Nothing+                  }+              ]+              (emptyManifest fixedTime)+      manifestFromJSON (manifestToJSON m) `shouldBe` Right m++    it "roundtrips a manifest with two instances of the same module" $ do+      let pv1 = ParentVars (Map.singleton (VarName "skill.name") "exec-plan")+          pv2 = ParentVars (Map.singleton (VarName "skill.name") "master-plan")+          m =+            withManifestModules+              [ AppliedModule+                  { name = ModuleName "claude-skill-link",+                    parentVars = pv1,+                    source = "/modules/claude-skill-link",+                    moduleVersion = Nothing,+                    appliedAt = fixedTime,+                    removal = Nothing+                  },+                AppliedModule+                  { name = ModuleName "claude-skill-link",+                    parentVars = pv2,+                    source = "/modules/claude-skill-link",+                    moduleVersion = Nothing,+                    appliedAt = fixedTime,+                    removal = Nothing+                  }+              ]+              (emptyManifest fixedTime)+      manifestFromJSON (manifestToJSON m) `shouldBe` Right m++  describe "AppliedBlueprint" $ do+    it "round-trips a fully populated entry through JSON" $ do+      let ab =+            AppliedBlueprint+              { name = ModuleName "payments-service",+                blueprintVersion = Just "0.3.1",+                appliedAt = fixedTime,+                baselineModules = [ModuleName "nix-flake", ModuleName "haskell-base"],+                noBaseline = False,+                userPrompt = Just "set this up for a payments microservice",+                agentSessionId = Nothing+              }+      Aeson.eitherDecode (Aeson.encode ab) `shouldBe` Right ab++    it "round-trips a --no-baseline entry through JSON" $ do+      let ab =+            AppliedBlueprint+              { name = ModuleName "lone-blueprint",+                blueprintVersion = Nothing,+                appliedAt = fixedTime,+                baselineModules = [],+                noBaseline = True,+                userPrompt = Nothing,+                agentSessionId = Nothing+              }+      Aeson.eitherDecode (Aeson.encode ab) `shouldBe` Right ab++    it "writeAppliedBlueprint replaces any prior entry" $ do+      let m0 = emptyManifest fixedTime+          ab1 =+            AppliedBlueprint+              (ModuleName "first")+              Nothing+              fixedTime+              []+              False+              Nothing+              Nothing+          ab2 =+            AppliedBlueprint+              (ModuleName "second")+              (Just "1.0.0")+              fixedTime2+              [ModuleName "x"]+              False+              (Just "do the thing")+              Nothing+          m1 = writeAppliedBlueprint ab1 m0+          m2 = writeAppliedBlueprint ab2 m1+      m1.blueprint `shouldBe` Just ab1+      m2.blueprint `shouldBe` Just ab2++  describe "schema back-compat" $ do+    -- A pre-EP-32 (schema v2) manifest has no @blueprint@ key. The+    -- decoder must read it as 'Nothing' regardless of the version+    -- field, so a pre-bump project does not refuse to load after the+    -- user upgrades seihou.+    it "decodes a v2 manifest with no blueprint key as Nothing" $ do+      let json = "{\"version\":2,\"generatedAt\":\"2026-03-01T10:30:00Z\",\"modules\":[],\"variables\":{},\"files\":{}}"+      case manifestFromJSON json of+        Right manifest -> do+          manifest.blueprint `shouldBe` Nothing+          manifest.version `shouldBe` 2+        Left err -> expectationFailure ("failed to parse: " <> err)++    it "decodes a v3 manifest with an explicit null blueprint as Nothing" $ do+      let json = "{\"version\":3,\"generatedAt\":\"2026-03-01T10:30:00Z\",\"modules\":[],\"variables\":{},\"files\":{},\"blueprint\":null}"+      case manifestFromJSON json of+        Right manifest -> manifest.blueprint `shouldBe` Nothing+        Left err -> expectationFailure ("failed to parse: " <> err)++    it "decodes a v3 manifest with a populated blueprint object" $ do+      let json =+            "{\"version\":3,\"generatedAt\":\"2026-03-01T10:30:00Z\",\"modules\":[],\"variables\":{},\"files\":{},"+              <> "\"blueprint\":{\"name\":\"payments-service\",\"version\":\"0.3.1\",\"appliedAt\":\"2026-03-01T11:00:00Z\","+              <> "\"baselineModules\":[\"nix-flake\"],\"noBaseline\":false,\"userPrompt\":\"set up payments\"}}"+      case manifestFromJSON json of+        Right manifest -> case manifest.blueprint of+          Just ab -> do+            ab.name `shouldBe` ModuleName "payments-service"+            ab.blueprintVersion `shouldBe` Just "0.3.1"+            ab.baselineModules `shouldBe` [ModuleName "nix-flake"]+            ab.noBaseline `shouldBe` False+            ab.userPrompt `shouldBe` Just "set up payments"+            ab.agentSessionId `shouldBe` Nothing+          Nothing -> expectationFailure "expected populated blueprint"+        Left err -> expectationFailure ("failed to parse: " <> err)++  describe "schema back-compat (version 1)" $ do+    it "decodes a version-1 manifest with parentVars defaulting to empty" $ do+      let json = "{\"version\":1,\"generatedAt\":\"2026-03-01T10:30:00Z\",\"modules\":[{\"name\":\"haskell-base\",\"source\":\"/path\",\"appliedAt\":\"2026-03-01T10:30:00Z\"}],\"variables\":{},\"files\":{}}"+      case manifestFromJSON json of+        Right manifest -> do+          length manifest.modules `shouldBe` 1+          (head manifest.modules).parentVars `shouldBe` emptyParentVars+        Left err -> expectationFailure ("failed to parse: " <> err)++    it "parses old manifest without version key as Nothing" $ do+      let json = "{\"version\":1,\"generatedAt\":\"2026-03-01T10:30:00Z\",\"modules\":[{\"name\":\"old-mod\",\"source\":\"/path\",\"appliedAt\":\"2026-03-01T10:30:00Z\"}],\"variables\":{},\"files\":{}}"+          result = manifestFromJSON json+      case result of+        Right manifest -> (head manifest.modules).moduleVersion `shouldBe` Nothing+        Left err -> expectationFailure ("failed to parse: " <> err)++  describe "version checking" $ do+    it "rejects manifests with version higher than current" $ do+      let base = emptyManifest fixedTime+          m = Manifest {version = 99, genAt = base.genAt, modules = base.modules, vars = base.vars, files = base.files, recipe = Nothing, blueprint = Nothing}+          result = manifestFromJSON (manifestToJSON m)+      case result of+        Left err -> err `shouldContain` "newer version"+        Right _ -> expectationFailure "should have rejected future version"++  describe "hashContent" $ do+    it "produces a hex-encoded SHA256 digest" $ do+      let h = hashContent "hello world"+      -- SHA256 of "hello world" is a well-known value+      h.unSHA256 `shouldBe` "b94d27b9934d3e08a52e52d7da7dabfac484efe37a5380ee9088f7ace2efcde9"++    it "produces different hashes for different content" $ do+      let h1 = hashContent "hello"+          h2 = hashContent "world"+      h1 `shouldNotBe` h2++    it "produces consistent hashes for the same content" $ do+      let h1 = hashContent "test content"+          h2 = hashContent "test content"+      h1 `shouldBe` h2++    it "produces a 64-character hex string" $ do+      let SHA256 hex = hashContent "anything"+      T.length hex `shouldBe` 64++    it "handles empty content" $ do+      let h = hashContent ""+      -- SHA256 of empty string is a well-known value+      h.unSHA256 `shouldBe` "e3b0c44298fc1c149afbf4c8996fb92427ae41e4649b934ca495991b7852b855"