seihou-core 0.5.0.0 → 0.6.0.0

raw patch · 96 files changed

+3720/−2619 lines, 96 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• seihou-core.cabal +9/−3
• src/Seihou/Composition/Graph.hs +15/−14
• src/Seihou/Composition/Instance.hs +9/−8
• src/Seihou/Composition/Plan.hs +11/−10
• src/Seihou/Composition/Recipe.hs +8/−6
• src/Seihou/Composition/Resolve.hs +44/−43
• src/Seihou/Core/AgentPrompt.hs +46/−25
• src/Seihou/Core/Application.hs +24/−19
• src/Seihou/Core/ArtifactOriginDetect.hs +115/−0
• src/Seihou/Core/ArtifactRef.hs +143/−0
• src/Seihou/Core/Blueprint.hs +54/−28
• src/Seihou/Core/CommandFingerprint.hs +3/−1
• src/Seihou/Core/CommandVar.hs +18/−17
• src/Seihou/Core/Migration.hs +33/−33
• src/Seihou/Core/Module.hs +102/−102
• src/Seihou/Core/Recipe.hs +8/−6
• src/Seihou/Core/Registry.hs +102/−99
• src/Seihou/Core/Scaffold.hs +4/−0
• src/Seihou/Core/Status.hs +5/−4
• src/Seihou/Core/Types.hs +245/−189
• src/Seihou/Core/Variable.hs +20/−19
• src/Seihou/Core/Version.hs +0/−1
• src/Seihou/Dhall/Eval.hs +39/−31
• src/Seihou/Effect/BaselineStoreInterp.hs +6/−5
• src/Seihou/Effect/BaselineStorePure.hs +3/−2
• src/Seihou/Effect/ConfigWriterPure.hs +19/−18
• src/Seihou/Effect/ConsolePure.hs +11/−10
• src/Seihou/Effect/FilesystemPure.hs +28/−22
• src/Seihou/Effect/LoggerPure.hs +10/−9
• src/Seihou/Effect/ProcessInterp.hs +2/−0
• src/Seihou/Effect/ProcessPure.hs +6/−5
• src/Seihou/Engine/Baseline.hs +8/−5
• src/Seihou/Engine/Conflict.hs +2/−1
• src/Seihou/Engine/Diff.hs +7/−6
• src/Seihou/Engine/Execute.hs +2/−1
• src/Seihou/Engine/Migrate.hs +28/−26
• src/Seihou/Engine/Plan.hs +23/−22
• src/Seihou/Engine/Preview.hs +36/−32
• src/Seihou/Engine/Reconcile.hs +78/−76
• src/Seihou/Engine/Remove.hs +33/−30
• src/Seihou/Engine/Section.hs +8/−7
• src/Seihou/Engine/Template.hs +7/−6
• src/Seihou/Engine/UpdateTransaction.hs +86/−85
• src/Seihou/Engine/Validate.hs +65/−64
• src/Seihou/Interaction/Confirm.hs +10/−9
• src/Seihou/Interaction/Prompt.hs +17/−16
• src/Seihou/Manifest/Types.hs +182/−109
• src/Seihou/Prelude.hs +33/−13
• test/Main.hs +5/−1
• test/Seihou/Composition/GraphSpec.hs +12/−10
• test/Seihou/Composition/InstanceSpec.hs +4/−2
• test/Seihou/Composition/ResolveSpec.hs +58/−56
• test/Seihou/Core/AgentPromptSpec.hs +97/−18
• test/Seihou/Core/ApplicationSpec.hs +23/−18
• test/Seihou/Core/ArtifactOriginDetectSpec.hs +83/−0
• test/Seihou/Core/ArtifactRefSpec.hs +141/−0
• test/Seihou/Core/BlueprintSpec.hs +149/−26
• test/Seihou/Core/CommandVarSpec.hs +16/−14
• test/Seihou/Core/ListSpec.hs +5/−3
• test/Seihou/Core/MigrationSpec.hs +31/−29
• test/Seihou/Core/ModuleSpec.hs +22/−24
• test/Seihou/Core/RegistrySpec.hs +64/−62
• test/Seihou/Core/RegistrySyncSpec.hs +34/−34
• test/Seihou/Core/ScaffoldSpec.hs +25/−23
• test/Seihou/Core/StatusSpec.hs +25/−28
• test/Seihou/Core/TypesSpec.hs +15/−13
• test/Seihou/Core/VariableSpec.hs +68/−66
• test/Seihou/Dhall/EvalSpec.hs +95/−93
• test/Seihou/Dhall/MigrationDecoderSpec.hs +16/−14
• test/Seihou/Effect/BaselineStoreSpec.hs +6/−4
• test/Seihou/Effect/ConfigWriterSpec.hs +10/−8
• test/Seihou/Effect/FilesystemSpec.hs +3/−1
• test/Seihou/Effect/LoggerSpec.hs +13/−11
• test/Seihou/Effect/ManifestStoreSpec.hs +9/−15
• test/Seihou/Engine/BaselineSpec.hs +9/−13
• test/Seihou/Engine/ConflictSpec.hs +12/−10
• test/Seihou/Engine/DiffSpec.hs +71/−73
• test/Seihou/Engine/ExecuteSpec.hs +19/−17
• test/Seihou/Engine/MigrateSpec.hs +34/−55
• test/Seihou/Engine/PlanSpec.hs +23/−25
• test/Seihou/Engine/PreviewSpec.hs +30/−35
• test/Seihou/Engine/ReconcileSpec.hs +33/−31
• test/Seihou/Engine/RemoveSpec.hs +59/−103
• test/Seihou/Engine/SectionSpec.hs +4/−3
• test/Seihou/Engine/UpdateTransactionSpec.hs +44/−42
• test/Seihou/Engine/ValidateSpec.hs +67/−65
• test/Seihou/Evaluation/ConditionalTemplateSpec.hs +9/−8
• test/Seihou/Evaluation/DhallTextFlakeSpec.hs +9/−8
• test/Seihou/Evaluation/SplitFlakeSpec.hs +9/−8
• test/Seihou/Integration/CompositionSpec.hs +17/−15
• test/Seihou/Integration/ExecutionSpec.hs +44/−42
• test/Seihou/Integration/GenerationSpec.hs +15/−13
• test/Seihou/Integration/ModuleLoadSpec.hs +21/−19
• test/Seihou/Interaction/ConfirmSpec.hs +22/−20
• test/Seihou/Interaction/PromptSpec.hs +59/−57
• test/Seihou/Manifest/TypesSpec.hs +314/−147

@@ -1,6 +1,6 @@ cabal-version: 3.0 name: seihou-core-version: 0.5.0.0+version: 0.6.0.0 synopsis: Core library for Seihou project scaffolding description:   Core library for Seihou, a composable project scaffolding system.@@ -24,10 +24,10 @@ library   default-language: GHC2024   default-extensions:+    DeriveAnyClass     DuplicateRecordFields     NoFieldSelectors     OverloadedLabels-    OverloadedRecordDot     OverloadedStrings     TypeFamilies @@ -40,6 +40,8 @@     Seihou.Composition.Resolve     Seihou.Core.AgentPrompt     Seihou.Core.Application+    Seihou.Core.ArtifactOriginDetect+    Seihou.Core.ArtifactRef     Seihou.Core.Blueprint     Seihou.Core.CommandFingerprint     Seihou.Core.CommandVar@@ -133,10 +135,10 @@   type: exitcode-stdio-1.0   default-language: GHC2024   default-extensions:+    DeriveAnyClass     DuplicateRecordFields     NoFieldSelectors     OverloadedLabels-    OverloadedRecordDot     OverloadedStrings    hs-source-dirs: test@@ -149,6 +151,8 @@     Seihou.Composition.ResolveSpec     Seihou.Core.AgentPromptSpec     Seihou.Core.ApplicationSpec+    Seihou.Core.ArtifactOriginDetectSpec+    Seihou.Core.ArtifactRefSpec     Seihou.Core.BlueprintSpec     Seihou.Core.CommandFingerprintSpec     Seihou.Core.CommandVarSpec@@ -212,7 +216,9 @@     directory >=1.3 && <2,     effectful-core >=2.4 && <3,     filepath >=1.4 && <2,+    generic-lens >=2.2 && <3,     hspec >=2.11 && <3,+    lens >=5.2 && <6,     seihou-core,     tasty >=1.4 && <2,     tasty-hspec >=1.2 && <2,

@@ -5,6 +5,7 @@   ) where +import Data.Generics.Labels () import Data.Map.Strict qualified as Map import Data.Set qualified as Set import Seihou.Composition.Instance (ModuleInstance (..), mkInstance)@@ -18,17 +19,17 @@ -- '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]+  { modules :: !(Map ModuleInstance Module),+    edges :: !(Map ModuleInstance [ModuleInstance])   }-  deriving stock (Eq, Show)+  deriving stock (Eq, Generic, 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'+-- @vars@ selects the instance created with those exact bindings;+-- a bare dependency (no @vars@) 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.@@ -36,18 +37,18 @@ buildGraph entries =   let present = Set.fromList (map fst entries)       edgesFor m =-        -- Dedupe edges: if a parent lists the same @(depModule, depVars)@+        -- Dedupe edges: if a parent lists the same @(module_, vars)@         -- 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),+          | dep <- m ^. #dependencies,+            let child = mkInstance (dep ^. #module_) (parentVarsFromDep dep),             Set.member child present           ]    in CompositionGraph-        { cgModules = Map.fromList entries,-          cgEdges = Map.fromList [(inst, edgesFor m) | (inst, m) <- entries]+        { modules = Map.fromList entries,+          edges = Map.fromList [(inst, edgesFor m) | (inst, m) <- entries]         }  -- | Topological sort using Kahn's algorithm, operating on@@ -62,12 +63,12 @@ topoSort graph = kahn initialReady initialInDegree [] allNodes   where     allNodes :: Set ModuleInstance-    allNodes = Map.keysSet graph.cgEdges+    allNodes = Map.keysSet (graph ^. #edges)      initialInDegree :: Map ModuleInstance Int     initialInDegree =       Map.fromList-        [ (n, length [d | d <- Map.findWithDefault [] n graph.cgEdges, Set.member d allNodes])+        [ (n, length [d | d <- Map.findWithDefault [] n (graph ^. #edges), Set.member d allNodes])         | n <- Set.toList allNodes         ] @@ -82,7 +83,7 @@     kahn [] _ result remaining       | Set.null remaining = Right (reverse result)       | otherwise =-          Left (CircularDependency (map (.instanceModule) (Set.toList remaining)))+          Left (CircularDependency (map (^. #module_) (Set.toList remaining)))     kahn (node : rest) inDeg result remaining =       let remaining' = Set.delete node remaining           (newReady, inDeg') = foldl (decrementDep node) ([], inDeg) (Set.toList remaining')@@ -90,7 +91,7 @@      decrementDep :: ModuleInstance -> ([ModuleInstance], Map ModuleInstance Int) -> ModuleInstance -> ([ModuleInstance], Map ModuleInstance Int)     decrementDep processed (ready, inDeg) candidate =-      let deps = Map.findWithDefault [] candidate graph.cgEdges+      let deps = Map.findWithDefault [] candidate (graph ^. #edges)        in if processed `elem` deps             then               let newDeg = Map.findWithDefault 0 candidate inDeg - 1

@@ -9,6 +9,7 @@  import Crypto.Hash.SHA256 qualified as SHA256 import Data.ByteString.Base16 qualified as Base16+import Data.Generics.Labels () import Data.Map.Strict qualified as Map import Data.Text qualified as T import Data.Text.Encoding qualified as TE@@ -27,15 +28,15 @@ -- one instance. See @docs/plans/10-parameterized-dep-multi-instantiation.md@ -- for the full rationale. data ModuleInstance = ModuleInstance-  { instanceModule :: ModuleName,-    instanceParentVars :: ParentVars+  { module_ :: !ModuleName,+    parentVars :: !ParentVars   }-  deriving stock (Eq, Ord, Show)+  deriving stock (Eq, Generic, 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}+mkInstance n pv = ModuleInstance {module_ = n, parentVars = pv}  -- | The 'ModuleInstance' for a top-level (primary / CLI-additional / -- recipe-expanded) module, which receives no parent-supplied bindings.@@ -59,13 +60,13 @@ -- 'ModuleName' alongside the bindings so output stays readable. qualifiedName :: ModuleInstance -> ModuleName qualifiedName inst =-  case Map.null inst.instanceParentVars.unParentVars of-    True -> inst.instanceModule+  case Map.null (inst ^. #parentVars . #unParentVars) of+    True -> (inst ^. #module_)     False ->       ModuleName $-        inst.instanceModule.unModuleName+        inst ^. #module_ . #unModuleName           <> "#"-          <> stableHash inst.instanceParentVars+          <> stableHash (inst ^. #parentVars)  -- | Compute the disambiguating hash for a 'ParentVars' set. --

@@ -9,6 +9,7 @@ import Data.Aeson qualified as Aeson import Data.Aeson.Encode.Pretty qualified as AesonPretty import Data.Aeson.KeyMap qualified as KM+import Data.Generics.Labels () import Data.Map.Strict qualified as Map import Data.Set qualified as Set import Data.Text qualified as T@@ -47,16 +48,16 @@           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+                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

@@ -3,6 +3,8 @@   ) where +import Control.Lens ((^.))+import Data.Generics.Labels () import Data.Map.Strict (Map) import Data.Map.Strict qualified as Map import Data.Text (Text)@@ -17,14 +19,14 @@ -- -- 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.+-- Variable overrides are collected from each module entry's @vars@ bindings. expandRecipe :: Recipe -> Either [Text] ExpandedRecipe expandRecipe recipe = do   validated <- validateRecipe recipe-  case validated.modules of+  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)+      let primaryName = (primary ^. #module_)+          additionalNames = map (^. #module_) additional+          overrides = Map.unions (map (^. #vars) (validated ^. #modules))+       in Right (primaryName, additionalNames, overrides, validated ^. #vars, validated ^. #prompts)

@@ -12,6 +12,7 @@ where  import Control.Monad.Trans.Except (ExceptT (..), runExceptT)+import Data.Generics.Labels () import Data.Map.Strict qualified as Map import Data.Set qualified as Set import Data.Text qualified as T@@ -39,7 +40,7 @@ -- 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 dependency edges to the same module with different @vars@ produce -- two distinct entries; identical edges dedupe. loadComposition ::   [FilePath] ->@@ -48,11 +49,11 @@   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}+  let effectiveDeps = primaryMod ^. #dependencies ++ map simpleDep additional+      effectivePrimary = (primaryMod & #dependencies .~ nubOrdBy (^. #module_) effectiveDeps)       primaryInst = primaryInstance primary       loaded = Map.singleton primaryInst (effectivePrimary, primaryDir)-      seeds = [(mkInstance dep.depModule (parentVarsFromDep dep)) | dep <- effectivePrimary.dependencies]+      seeds = [(mkInstance (dep ^. #module_) (parentVarsFromDep dep)) | dep <- effectivePrimary ^. #dependencies]   allInstances <- ExceptT $ loadTransitive searchPaths loaded seeds   let entries = [(inst, m) | (inst, (m, _)) <- Map.toList allInstances]       graph = buildGraph entries@@ -111,11 +112,11 @@     go _ [] perModule _ = Right perModule     go parentVarsMap ((inst, m, _dir) : rest) perModule allExports = do       let visibleExports = gatherEdgeExports m allExports-          adjustedDecls = map (injectExportDefault visibleExports) m.vars+          adjustedDecls = map (injectExportDefault visibleExports) (m ^. #vars)           myParentVars = Map.findWithDefault Map.empty inst parentVarsMap           saved = Map.findWithDefault Map.empty inst savedValues       resolved <- resolveVariablesWithSaved adjustedDecls cliOverrides saved envVars namespace context localConfig nsConfig ctxConfig globalConfig myParentVars-      let declaredNames = Set.fromList (map (.name) m.vars)+      let declaredNames = Set.fromList (map (^. #name) (m ^. #vars))           inherited =             Map.mapWithKey               makeInheritedResolved@@ -183,12 +184,12 @@     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+          adjustedDecls = map (injectExportDefault visibleExports) (m ^. #vars)           myParentVars = Map.findWithDefault Map.empty inst parentVarsMap           saved = Map.findWithDefault Map.empty inst savedValues       case resolveVariablesWithSaved adjustedDecls cliOverrides saved envVars namespace context localConfig nsConfig ctxConfig globalConfig myParentVars of         Right resolved -> do-          let declaredNames = Set.fromList (map (.name) m.vars)+          let declaredNames = Set.fromList (map (^. #name) (m ^. #vars))               inherited =                 Map.mapWithKey                   makeInheritedResolved@@ -197,18 +198,18 @@           let optionalDecls =                 [ d                 | d <- adjustedDecls,-                  not d.required,-                  not (Map.member d.name resolvedWithInherited),-                  any (\p -> p.var == d.name) m.prompts+                  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+                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+                runPrompts (m ^. #prompts) optionalDecls allBindings               else pure Map.empty           let fullResolved = resolvedWithInherited `Map.union` optionalPrompted               myExports = exportedVars m fullResolved@@ -226,16 +227,16 @@               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 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+                              Map.map (varValueToText . (^. #value)) prompted                       case resolveVariablesWithSaved adjustedDecls promptedOverrides saved envVars namespace context localConfig nsConfig ctxConfig globalConfig myParentVars of                         Left errs' -> pure (Left errs')                         Right resolved -> do@@ -247,7 +248,7 @@                                         Nothing -> rv                                   )                                   resolved-                              declaredNames = Set.fromList (map (.name) m.vars)+                              declaredNames = Set.fromList (map (^. #name) (m ^. #vars))                               inherited =                                 Map.mapWithKey                                   makeInheritedResolved@@ -256,18 +257,18 @@                           let optionalDecls' =                                 [ d                                 | d <- adjustedDecls,-                                  not d.required,-                                  not (Map.member d.name resolvedWithInherited'),-                                  any (\p -> p.var == d.name) m.prompts+                                  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+                                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+                                runPrompts (m ^. #prompts) optionalDecls' ab                               else pure Map.empty                           let fullResolved = resolvedWithInherited' `Map.union` optionalPrompted'                               myExports = exportedVars m fullResolved@@ -281,7 +282,7 @@ -- | 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+-- @(module_, vars)@, not just the module name, so that two -- sibling instances of the same module contribute their own -- per-instance exports without interference. gatherEdgeExports ::@@ -291,8 +292,8 @@ gatherEdgeExports m allExports =   Map.unions     [ Map.findWithDefault Map.empty childInst allExports-    | dep <- m.dependencies,-      let childInst = mkInstance dep.depModule (parentVarsFromDep dep)+    | dep <- m ^. #dependencies,+      let childInst = mkInstance (dep ^. #module_) (parentVarsFromDep dep)     ]  -- | Extract the variable name from a MissingRequiredVar error.@@ -320,14 +321,14 @@ 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]+    [ (exportName e, rv ^. #value)+    | e <- m ^. #exports,+      Just rv <- [Map.lookup (e ^. #var) resolved]     ]   where-    exportName e = case e.alias of+    exportName e = case e ^. #alias of       Just a -> a-      Nothing -> e.var+      Nothing -> (e ^. #var)  -- Internal helpers @@ -365,14 +366,14 @@ loadTransitive searchPaths loaded (inst : rest)   | Map.member inst loaded = loadTransitive searchPaths loaded rest   | otherwise = do-      result <- loadModuleWithDir searchPaths inst.instanceModule+      result <- loadModuleWithDir searchPaths (inst ^. #module_)       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+                [ mkInstance (dep ^. #module_) (parentVarsFromDep dep)+                | dep <- m ^. #dependencies                 ]           loadTransitive searchPaths loaded' (rest ++ newInstances) @@ -381,8 +382,8 @@ -- 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}+  case Map.lookup (decl ^. #name) exports of+    Just val -> (decl & #default_ ?~ val)     Nothing -> decl  -- | Create a ResolvedVar for an inherited (non-declared) export variable.@@ -415,7 +416,7 @@ -- 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+-- decorations independently. A child edge's @vars@ uniquely -- identifies the target instance, so no merging of overlapping -- bindings is required: each @(ModuleInstance, edgeVars)@ pair is -- distinct by construction.@@ -424,11 +425,11 @@   Map ModuleInstance (Map VarName (Text, ModuleName)) collectParentVars modules =   Map.fromList-    [ (childInst, Map.map (,m.name) dep.depVars)+    [ (childInst, Map.map (,m ^. #name) (dep ^. #vars))     | (_, m, _) <- modules,-      dep <- m.dependencies,-      not (Map.null dep.depVars),-      let childInst = mkInstance dep.depModule (parentVarsFromDep dep)+      dep <- m ^. #dependencies,+      not (Map.null (dep ^. #vars)),+      let childInst = mkInstance (dep ^. #module_) (parentVarsFromDep dep)     ]  -- | Remove duplicates from a list while preserving order, using a key function.

@@ -10,9 +10,11 @@     checkAgentPromptFiles,     checkAgentPromptTags,     checkAgentPromptAllowedTools,+    checkAgentPromptLaunch,   ) where +import Data.Generics.Labels () import Data.Set qualified as Set import Data.Text qualified as T import Numeric.Natural (Natural)@@ -38,21 +40,22 @@           <> checkAgentPromptGuidance p           <> checkAgentPromptTags p           <> checkAgentPromptAllowedTools p+          <> checkAgentPromptLaunch p       allErrs = pureErrs <> fileErrs   pure $     if null allErrs       then Right p-      else Left (ValidationError p.name allErrs)+      else Left (ValidationError (p ^. #name) allErrs)  checkAgentPromptNameFormat :: AgentPrompt -> [Text] checkAgentPromptNameFormat p =-  let n = p.name.unModuleName+  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+checkAgentPromptVersionPresent p = case p ^. #version of   Nothing -> []   Just v     | T.null (T.strip v) -> ["prompt version, if specified, must not be empty"]@@ -60,30 +63,30 @@  checkAgentPromptBodyNonEmpty :: AgentPrompt -> [Text] checkAgentPromptBodyNonEmpty p-  | T.null (T.strip p.prompt) = ["prompt body must not be empty"]+  | 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+  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)+  let varNames = Set.fromList (map (^. #name) (p ^. #vars))    in concatMap         ( \prompt ->-            if Set.member prompt.var varNames+            if Set.member (prompt ^. #var) varNames               then []-              else ["prompt references undeclared variable: " <> prompt.var.unVarName]+              else ["prompt references undeclared variable: " <> prompt ^. #var . #unVarName]         )-        p.prompts+        (p ^. #prompts)  checkAgentPromptCommandVars :: AgentPrompt -> [Text] checkAgentPromptCommandVars p =-  duplicateCommandVars <> concatMap checkCommandVar p.commandVars+  duplicateCommandVars <> concatMap checkCommandVar (p ^. #commandVars)   where-    commandNames = map (\cv -> cv.name.unVarName) p.commandVars+    commandNames = map (\cv -> cv ^. #name . #unVarName) (p ^. #commandVars)      duplicateCommandVars =       map@@ -91,14 +94,14 @@         (findDupes Set.empty Set.empty commandNames)      checkCommandVar cv =-      checkName cv <> checkRun cv <> checkWorkDir cv.workDir <> checkMaxBytes cv.maxBytes+      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"]+      | 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"]+      | T.null (T.strip (cv ^. #run)) = ["command variable '" <> cv ^. #name . #unVarName <> "' run must not be empty"]       | otherwise = []      checkWorkDir Nothing = []@@ -118,26 +121,26 @@  checkAgentPromptGuidance :: AgentPrompt -> [Text] checkAgentPromptGuidance p =-  concatMap checkGuidance p.guidance+  concatMap checkGuidance (p ^. #guidance)   where-    knownVars = Set.fromList (map (.name) p.vars <> map (.name) p.commandVars)+    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"]+      | 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"]+      | T.null (T.strip (g ^. #body)) = ["guidance body must not be empty"]       | otherwise = []      checkConditionRefs g =-      case g.condition of+      case g ^. #condition of         Nothing -> []         Just cond ->-          [ "guidance '" <> g.title <> "' references undeclared variable: " <> ref.unVarName+          [ "guidance '" <> g ^. #title <> "' references undeclared variable: " <> ref ^. #unVarName           | (ref, _) <- exprRefs cond,             not (Set.member ref knownVars)           ]@@ -147,30 +150,48 @@   concat     <$> mapM       ( \pf -> do-          let path = baseDir </> "files" </> pf.src+          let path = baseDir </> "files" </> (pf ^. #src)           exists <- doesFileExist path           pure $             if exists               then []-              else ["prompt file not found: " <> T.pack pf.src]+              else ["prompt file not found: " <> T.pack (pf ^. #src)]       )-      p.files+      (p ^. #files)  checkAgentPromptTags :: AgentPrompt -> [Text] checkAgentPromptTags p =   [ "tag must not be empty"-  | t <- p.tags,+  | t <- p ^. #tags,     T.null (T.strip t)   ]  checkAgentPromptAllowedTools :: AgentPrompt -> [Text]-checkAgentPromptAllowedTools p = case p.allowedTools of+checkAgentPromptAllowedTools p = case p ^. #allowedTools of   Nothing -> []   Just xs ->     [ "allowedTools entry must not be empty"     | t <- xs,       T.null (T.strip t)     ]++-- | Every field the @launch@ record does set must be non-blank. The declared+-- values themselves (which provider, which effort) are parsed by the CLI+-- layer, which owns those vocabularies; core only rejects blanks.+checkAgentPromptLaunch :: AgentPrompt -> [Text]+checkAgentPromptLaunch p = case p ^. #launch of+  Nothing -> []+  Just l ->+    blankErr "provider" (l ^. #provider)+      <> blankErr "model" (l ^. #model)+      <> blankErr "effort" (l ^. #effort)+      <> blankErr "mode" (l ^. #mode)+  where+    blankErr key value =+      [ "launch." <> key <> ", if specified, must not be empty"+      | Just v <- [value],+        T.null (T.strip v)+      ]  findDupes :: Set.Set Text -> Set.Set Text -> [Text] -> [Text] findDupes _ _ [] = []

@@ -6,6 +6,8 @@   ) where +import Control.Lens ((&), (.~), (^.))+import Data.Generics.Labels () import Data.Map.Strict (Map) import Data.Map.Strict qualified as Map import Data.Set qualified as Set@@ -21,38 +23,42 @@ -- update replaces the same application record. mkApplicationId :: AppliedTarget -> [ModuleName] -> ApplicationId mkApplicationId target additional =-  ApplicationId (hashContent canonical).unSHA256+  ApplicationId ((hashContent canonical) ^. #unSHA256)   where     (kind, targetName) = case target of-      AppliedModuleTarget name -> ("module", name.unModuleName)-      AppliedRecipeTarget name -> ("recipe", name.unRecipeName)+      AppliedModuleTarget name -> ("module", name ^. #unModuleName)+      AppliedRecipeTarget name -> ("recipe", name ^. #unRecipeName)     canonical =       T.intercalate         "\n"         ( [ "target-kind=" <> kind,             "target-name=" <> targetName           ]-            ++ map ("additional=" <>) (map (.unModuleName) additional)+            ++ map ("additional=" <>) (map (^. #unModuleName) additional)         )  -- | Capture a composition using the already-resolved, instance-scoped -- values from the generation pipeline.+--+-- The target and each module instance are identified by the portable+-- 'ArtifactOrigin' the manifest records, never by the directory they happened+-- to be loaded from on this machine. buildAppliedComposition ::   AppliedTarget ->-  FilePath ->+  ArtifactOrigin ->   Maybe Text ->   [ModuleName] ->   Maybe Text ->   Maybe Text ->-  [(ModuleInstance, Module, FilePath)] ->+  [(ModuleInstance, Module, ArtifactOrigin)] ->   Map ModuleInstance (Map VarName ResolvedVar) ->   UTCTime ->   AppliedComposition-buildAppliedComposition target targetSource targetVersion additional namespace context modulesInOrder resolved now =+buildAppliedComposition target targetOrigin targetVersion additional namespace context modulesInOrder resolved now =   AppliedComposition     { applicationId = mkApplicationId target additional,       target = target,-      targetSource = targetSource,+      targetOrigin = targetOrigin,       targetVersion = targetVersion,       additionalModules = additional,       namespace = namespace,@@ -62,24 +68,24 @@       appliedAt = now     }   where-    buildInstance (inst, modul, source) =+    buildInstance (inst, modul, origin) =       AppliedInstanceState-        { name = inst.instanceModule,-          parentVars = inst.instanceParentVars,-          source = source,-          moduleVersion = modul.version,-          resolvedVars = Map.map (varValueToText . (.value)) (Map.findWithDefault Map.empty inst resolved)+        { name = inst ^. #module_,+          parentVars = inst ^. #parentVars,+          origin = origin,+          moduleVersion = modul ^. #version,+          resolvedVars = Map.map (varValueToText . (^. #value)) (Map.findWithDefault Map.empty inst resolved)         }  -- | Replace an existing application in place, or append a newly-applied one. replaceAppliedComposition :: AppliedComposition -> [AppliedComposition] -> [AppliedComposition] replaceAppliedComposition replacement existing-  | any ((== replacement.applicationId) . (.applicationId)) existing =+  | any ((== replacement ^. #applicationId) . (^. #applicationId)) existing =       map replaceMatching existing   | otherwise = existing ++ [replacement]   where     replaceMatching current-      | current.applicationId == replacement.applicationId = replacement+      | current ^. #applicationId == (replacement ^. #applicationId) = replacement       | otherwise = current  -- | Attribute the current file result to an application while retaining@@ -89,10 +95,9 @@ attachApplication :: ApplicationId -> Maybe FileRecord -> FileRecord -> FileRecord attachApplication applicationId previous current =   current-    { applicationIds = Set.insert applicationId (Set.union current.applicationIds priorApplications)-    }+    & #applicationIds .~ Set.insert applicationId (Set.union (current ^. #applicationIds) priorApplications)   where-    priorApplications = maybe Set.empty (.applicationIds) previous+    priorApplications = maybe Set.empty (^. #applicationIds) previous  varValueToText :: VarValue -> Text varValueToText (VText value) = value

@@ -0,0 +1,115 @@+-- | Turn an absolute artifact directory into a portable 'ArtifactOrigin'.+--+-- Module discovery hands every caller an absolute directory, because+-- @Seihou.Core.Module.defaultSearchPaths@ is built from+-- 'System.Directory.getCurrentDirectory' and+-- 'System.Directory.getXdgDirectory'. Absolute paths must never reach+-- @.seihou\/manifest.json@, which is checked into version control and read+-- on other developers' machines, so every manifest write site funnels its+-- directory through 'detectArtifactOrigin' first.+--+-- The read side of @.seihou-origin.json@ lives here rather than in+-- @seihou-cli@ because this module needs it and @seihou-core@ cannot depend+-- on @seihou-cli-internal@. @Seihou.CLI.InstallShared@ re-exports it, so+-- existing importers are unaffected; the write side ('OriginMeta',+-- @installModuleDir@) stays in the CLI.+module Seihou.Core.ArtifactOriginDetect+  ( detectArtifactOrigin,+    OriginInfo (..),+    readOriginInfo,+  )+where++import Control.Exception (IOException, try)+import Data.Aeson (FromJSON (..), withObject, (.:), (.:?))+import Data.Aeson qualified as Aeson+import Data.ByteString.Lazy qualified as LBS+import Data.Generics.Labels ()+import Data.Text qualified as T+import Seihou.Core.Types (ArtifactOrigin (..))+import Seihou.Prelude+import System.Directory (canonicalizePath, doesFileExist)+import System.FilePath (makeRelative, pathSeparator, takeFileName)++-- | Read side of @.seihou-origin.json@. Tolerates files written by older+-- 'seihou install' runs that may have been missing optional fields.+data OriginInfo = OriginInfo+  { sourceUrl :: !Text,+    repoName :: !(Maybe Text),+    version :: !(Maybe Text)+  }+  deriving stock (Eq, Generic, Show)++instance FromJSON OriginInfo where+  parseJSON = withObject "OriginInfo" $ \v ->+    OriginInfo <$> v .: "sourceUrl" <*> v .:? "repoName" <*> v .:? "version"++-- | Read and parse @.seihou-origin.json@ at the given installed-module+-- directory. Returns 'Nothing' if the file is absent or unparseable.+readOriginInfo :: FilePath -> IO (Maybe OriginInfo)+readOriginInfo installedDir = do+  let path = installedDir </> ".seihou-origin.json"+  exists <- doesFileExist path+  if not exists+    then pure Nothing+    else do+      bs <- LBS.readFile path+      pure (Aeson.decode bs)++-- | Classify an absolute artifact directory into a portable origin.+--+-- @projectRoot@ is the absolute path of the project being generated into+-- (the directory holding @.seihou@). @artifactDir@ is the absolute+-- directory that holds the artifact's @module.dhall@, @recipe.dhall@,+-- @blueprint.dhall@, or @prompt.dhall@.+--+-- Classification, in order:+--+--   1. If @artifactDir@ is inside @projectRoot@, the result is a+--      'ProjectOrigin' holding the path relative to @projectRoot@ with+--      forward slashes.+--   2. Otherwise, if @artifactDir@ contains a readable+--      @.seihou-origin.json@ with a @sourceUrl@, the result is a+--      'RemoteOrigin' carrying that URL, the directory's base name, and+--      the recorded @repoName@.+--   3. Otherwise the result is a 'LocalOrigin' holding the directory's+--      base name.+detectArtifactOrigin :: FilePath -> FilePath -> IO ArtifactOrigin+detectArtifactOrigin projectRoot artifactDir = do+  root <- canonicalizeOr projectRoot+  dir <- canonicalizeOr artifactDir+  case insideProject root dir of+    Just relative -> pure (ProjectOrigin relative)+    Nothing -> do+      originInfo <- readOriginInfo dir+      let name = T.pack (takeFileName dir)+      pure $ case originInfo of+        Just info -> RemoteOrigin (info ^. #sourceUrl) name (info ^. #repoName)+        Nothing -> LocalOrigin name++-- | 'canonicalizePath' throws when an intermediate component does not+-- exist, which happens in tests and for artifacts that were removed between+-- discovery and manifest write. Fall back to the raw path in that case.+canonicalizeOr :: FilePath -> IO FilePath+canonicalizeOr path = do+  result <- try @IOException (canonicalizePath path)+  pure (either (const path) id result)++-- | The artifact directory's path relative to the project root, when it is+-- genuinely inside it.+--+-- 'makeRelative' returns its second argument unchanged when the two paths+-- share no prefix, and returns @"."@ when they are the same directory, so+-- both cases have to be rejected explicitly. A leading @".."@ cannot appear+-- (GHC's 'makeRelative' never produces one) but is rejected anyway so a+-- future implementation change cannot smuggle an escaping path into the+-- manifest.+insideProject :: FilePath -> FilePath -> Maybe FilePath+insideProject root dir+  | relative == dir = Nothing+  | relative == "." = Nothing+  | take 2 relative == ".." = Nothing+  | otherwise = Just (map toForwardSlash relative)+  where+    relative = makeRelative root dir+    toForwardSlash c = if c == pathSeparator then '/' else c

@@ -0,0 +1,143 @@+-- | Turn an artifact origin recorded in the manifest into a directory on+-- this machine.+--+-- @.seihou\/manifest.json@ is checked into version control and records no+-- absolute path (see+-- docs\/adr\/0001-manifest-is-a-checked-in-machine-independent-artifact.md),+-- so every command that needs an artifact's bytes has to ask this question+-- first. This module is the single place that answers it, and the single+-- place that phrases the answer when it is "not here".+module Seihou.Core.ArtifactRef+  ( ArtifactRefError (..),+    resolveArtifactOrigin,+    renderArtifactRefError,+  )+where++import Data.Generics.Labels ()+import Data.Text qualified as T+import Seihou.Core.Types (ArtifactOrigin (..))+import Seihou.Prelude+import System.Directory (doesFileExist)+import System.FilePath (joinPath)++-- | Why an origin recorded in the manifest could not be turned into a+-- directory on this machine.+data ArtifactRefError+  = -- | Nothing named by the origin exists in any search path. Carries the+    -- origin and the exact directories that were probed, in order.+    ArtifactNotFoundLocally !ArtifactOrigin ![FilePath]+  | -- | A 'ProjectOrigin' pointed at a path inside the project that does+    -- not exist. Carries the origin and the absolute path that was tried.+    ProjectArtifactMissing !ArtifactOrigin !FilePath+  deriving stock (Eq, Show, Generic)++-- | Turn a recorded origin into the absolute directory on this machine+-- that holds the artifact's definition file.+--+-- @projectRoot@ is the absolute directory containing @.seihou@.+-- @searchPaths@ is normally 'Seihou.Core.Module.defaultSearchPaths'; it is+-- a parameter so tests can supply temporary directories.+-- @definitionFile@ is the file that must be present for a directory to+-- count as the artifact — @"module.dhall"@ for modules,+-- @"recipe.dhall"@ for recipes, @"blueprint.dhall"@ for blueprints.+--+-- A 'ProjectOrigin' resolves against the project root and nowhere else. If+-- the recorded directory is absent the repository is incomplete, and+-- quietly substituting a globally installed artifact of the same name would+-- be exactly the invisible substitution the portable manifest exists to+-- prevent.+--+-- A 'RemoteOrigin' or 'LocalOrigin' resolves by name through @searchPaths@+-- in the ordinary discovery order, so a developer who deliberately shadows+-- an installed module with a project-local copy keeps that shadowing.+-- Whether what was found actually matches the recorded origin is a separate+-- question, answered by+-- docs\/plans\/78-refuse-accidental-module-downgrades-and-origin-mismatches.md.+resolveArtifactOrigin ::+  FilePath ->+  [FilePath] ->+  FilePath ->+  ArtifactOrigin ->+  IO (Either ArtifactRefError FilePath)+resolveArtifactOrigin projectRoot searchPaths definitionFile origin = case origin of+  ProjectOrigin relative -> do+    let candidate = projectRoot </> fromPortablePath relative+    present <- hasDefinition candidate+    pure $+      if present+        then Right candidate+        else Left (ProjectArtifactMissing origin candidate)+  RemoteOrigin _ artifact _ -> searchByName artifact+  LocalOrigin artifact -> searchByName artifact+  where+    searchByName artifact = do+      let candidates = [dir </> T.unpack artifact | dir <- searchPaths]+      found <- firstPresent candidates+      pure (maybe (Left (ArtifactNotFoundLocally origin candidates)) Right found)++    firstPresent [] = pure Nothing+    firstPresent (candidate : rest) = do+      present <- hasDefinition candidate+      if present then pure (Just candidate) else firstPresent rest++    hasDefinition directory = doesFileExist (directory </> definitionFile)++-- | The manifest stores project-relative paths with forward slashes so a+-- manifest written on Windows matches one written on POSIX. Turn one back+-- into a native path.+fromPortablePath :: FilePath -> FilePath+fromPortablePath = joinPath . filter (not . null) . splitOnSlash+  where+    splitOnSlash path = case break (== '/') path of+      (segment, []) -> [segment]+      (segment, _ : rest) -> segment : splitOnSlash rest++-- | Render a resolution failure as the multi-line message the user sees.+--+-- Callers prepend their own one-line context ("cannot plan a migration",+-- "cannot regenerate"); the body below is identical everywhere so a reader+-- who has seen it once recognises it.+renderArtifactRefError :: ArtifactRefError -> Text+renderArtifactRefError (ProjectArtifactMissing origin candidate) =+  T.intercalate+    "\n"+    [ "Artifact '" <> artifactOriginLabel origin <> "' is recorded in .seihou/manifest.json",+      "as living inside this project, but the directory is missing.",+      "",+      "  Expected at: " <> T.pack candidate,+      "",+      "This directory should be committed alongside the manifest. Restore it",+      "from version control, or re-run the module that creates it."+    ]+renderArtifactRefError (ArtifactNotFoundLocally origin candidates) =+  T.intercalate "\n" (header <> [""] <> recordedOrigin <> searched <> [""] <> remedy)+  where+    label = artifactOriginLabel origin++    header =+      [ "Artifact '" <> label <> "' is recorded in .seihou/manifest.json but is not",+        "installed on this machine."+      ]++    recordedOrigin = case origin of+      RemoteOrigin url _ _ -> ["  Recorded origin: " <> url, ""]+      _ -> []++    searched = "  Searched:" : ["    " <> T.pack candidate | candidate <- candidates]++    remedy = case origin of+      RemoteOrigin url _ _ ->+        [ "  Install it with:",+          "    seihou install " <> url+        ]+      _ ->+        [ "  This artifact has no recorded upstream, so seihou cannot fetch it.",+          "  Place a copy in one of the directories above."+        ]++-- | The name to show a user for an origin.+artifactOriginLabel :: ArtifactOrigin -> Text+artifactOriginLabel (RemoteOrigin _ artifact _) = artifact+artifactOriginLabel (LocalOrigin artifact) = artifact+artifactOriginLabel (ProjectOrigin relative) = T.pack relative

@@ -12,9 +12,11 @@     checkBlueprintTags,     checkBlueprintAllowedTools,     checkBlueprintMigrations,+    checkBlueprintLaunch,   ) where +import Data.Generics.Labels () import Data.Map.Strict qualified as Map import Data.Set qualified as Set import Data.Text qualified as T@@ -43,6 +45,11 @@ --   7. Every @files@ entry exists at @baseDir/files/SRC@. --   8. Every tag is non-empty. --   9. Every @allowedTools@ entry, when set, is non-empty.+--  10. Every migration is a forward dotted-numeric edge with a non-empty+--      prompt, and each starting version occurs at most once.+--  11. Every field the @launch@ record does set is non-blank. The values+--      themselves are parsed by the CLI, which owns the provider and effort+--      vocabularies. validateBlueprint :: FilePath -> Blueprint -> IO (Either ModuleLoadError Blueprint) validateBlueprint baseDir b = do   searchPaths <- defaultSearchPaths@@ -69,23 +76,24 @@           <> checkBlueprintTags b           <> checkBlueprintAllowedTools b           <> checkBlueprintMigrations b+          <> checkBlueprintLaunch b       allErrs = pureErrs <> fileErrs <> baseErrs   pure $     if null allErrs       then Right b-      else Left (ValidationError b.name allErrs)+      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+  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+checkBlueprintVersionPresent b = case b ^. #version of   Nothing -> []   Just v     | T.null (T.strip v) -> ["blueprint version, if specified, must not be empty"]@@ -94,13 +102,13 @@ -- 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"]+  | 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+  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]@@ -112,14 +120,14 @@ -- Rule 5: every prompt references a declared variable checkBlueprintPromptRefs :: Blueprint -> [Text] checkBlueprintPromptRefs b =-  let varNames = Set.fromList (map (.name) b.vars)+  let varNames = Set.fromList (map (^. #name) (b ^. #vars))    in concatMap         ( \p ->-            if Set.member p.var varNames+            if Set.member (p ^. #var) varNames               then []-              else ["prompt references undeclared variable: " <> p.var.unVarName]+              else ["prompt references undeclared variable: " <> p ^. #var . #unVarName]         )-        b.prompts+        (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@@ -132,25 +140,25 @@  checkBlueprintBaseModulesWith :: [FilePath] -> Blueprint -> IO [Text] checkBlueprintBaseModulesWith searchPaths b =-  concat <$> mapM (checkOne searchPaths) b.baseModules+  concat <$> mapM (checkOne searchPaths) (b ^. #baseModules)   where     checkOne :: [FilePath] -> Dependency -> IO [Text]     checkOne paths dep = do-      let n = dep.depModule.unModuleName+      let n = (dep ^. #module_ . #unModuleName)           nameErrs =             [ "invalid baseModule name: " <> n             | not (isValidModuleName n)             ]           bindingErrs =             [ "baseModule '" <> n <> "' has invalid var binding name: " <> vn-            | (VarName vn) <- Map.keys dep.depVars,+            | (VarName vn) <- Map.keys (dep ^. #vars),               not (isValidVarBindingName vn)             ]       resolveErrs <-         if not (isValidModuleName n)           then pure []           else do-            result <- discoverRunnable paths dep.depModule+            result <- discoverRunnable paths (dep ^. #module_)             pure $ case result of               Right (RunnableModule _ _) -> []               Right (RunnableRecipe _ _) -> []@@ -181,26 +189,26 @@   concat     <$> mapM       ( \bf -> do-          let p = baseDir </> "files" </> bf.src+          let p = baseDir </> "files" </> (bf ^. #src)           exists <- doesFileExist p           pure $             if exists               then []-              else ["blueprint file not found: " <> T.pack bf.src]+              else ["blueprint file not found: " <> T.pack (bf ^. #src)]       )-      b.files+      (b ^. #files)  -- Rule 8: tags must not be empty strings checkBlueprintTags :: Blueprint -> [Text] checkBlueprintTags b =   [ "tag must not be empty"-  | t <- b.tags,+  | 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+checkBlueprintAllowedTools b = case b ^. #allowedTools of   Nothing -> []   Just xs ->     [ "allowedTools entry must not be empty"@@ -212,23 +220,23 @@ -- non-empty prompt, and each starting version occurs at most once. checkBlueprintMigrations :: Blueprint -> [Text] checkBlueprintMigrations b =-  concatMap checkOne b.migrations <> duplicateErrors+  concatMap checkOne (b ^. #migrations) <> duplicateErrors   where     checkOne :: BlueprintMigration -> [Text]     checkOne migration =       promptErrors migration-        <> versionErrors "from" migration.from-        <> versionErrors "to" migration.to+        <> versionErrors "from" (migration ^. #from)+        <> versionErrors "to" (migration ^. #to)         <> orderErrors migration      promptErrors :: BlueprintMigration -> [Text]     promptErrors migration =       [ "blueprint migration "-          <> migration.from+          <> migration ^. #from           <> " -> "-          <> migration.to+          <> migration ^. #to           <> " prompt must not be empty"-      | T.null (T.strip migration.prompt)+      | T.null (T.strip (migration ^. #prompt))       ]      versionErrors label versionText = case parseVersion versionText of@@ -236,17 +244,35 @@       Just _ -> []      orderErrors :: BlueprintMigration -> [Text]-    orderErrors migration = case (parseVersion migration.from, parseVersion migration.to) of+    orderErrors migration = case (parseVersion (migration ^. #from), parseVersion (migration ^. #to)) of       (Just fromVersion, Just toVersion)         | fromVersion >= toVersion ->             [ "blueprint migration must advance versions: "-                <> migration.from+                <> migration ^. #from                 <> " -> "-                <> migration.to+                <> migration ^. #to             ]       _ -> []      duplicateErrors =       map         ("duplicate blueprint migration from version: " <>)-        (findDupes Set.empty Set.empty (map (.from) b.migrations))+        (findDupes Set.empty Set.empty (map (^. #from) (b ^. #migrations)))++-- Rule 11: every field the @launch@ record does set must be non-blank. The+-- declared values themselves (which provider, which effort) are parsed by the+-- CLI layer, which owns those vocabularies; core only rejects blanks.+checkBlueprintLaunch :: Blueprint -> [Text]+checkBlueprintLaunch b = case b ^. #launch of+  Nothing -> []+  Just l ->+    blankErr "provider" (l ^. #provider)+      <> blankErr "model" (l ^. #model)+      <> blankErr "effort" (l ^. #effort)+      <> blankErr "mode" (l ^. #mode)+  where+    blankErr key value =+      [ "launch." <> key <> ", if specified, must not be empty"+      | Just v <- [value],+        T.null (T.strip v)+      ]

@@ -3,6 +3,8 @@   ) where +import Control.Lens ((^.))+import Data.Generics.Labels () import Data.Text qualified as T import Seihou.Core.Types import Seihou.Manifest.Hash (hashContent)@@ -15,7 +17,7 @@   Just . CommandFingerprint . hashContent $     T.intercalate       "\n"-      [ "module=" <> moduleName.unModuleName,+      [ "module=" <> moduleName ^. #unModuleName,         "command=" <> command,         "work-dir=" <> T.pack (normalise (maybe "." id workDir)),         "occurrence=" <> T.pack (show occurrence)

@@ -5,6 +5,7 @@   ) where +import Data.Generics.Labels () import Data.Map.Strict qualified as Map import Data.Text qualified as T import Seihou.Core.Expr (evalExpr)@@ -24,18 +25,18 @@     conditionBindings = resolvedValues existing <> bindings      shouldRun cv =-      not (Map.member cv.name existing)-        && maybe True (evalExpr conditionBindings) cv.condition+      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+  case filter (\decl -> decl ^. #name == cv ^. #name) decls of     decl : _ -> decl     [] ->       VarDecl-        { name = cv.name,+        { name = cv ^. #name,           type_ = VTText,           default_ = Nothing,           description = Nothing,@@ -63,15 +64,15 @@   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+      | 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+              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@@ -79,13 +80,13 @@       case validateWorkDir cv of         Left err -> pure (Left err)         Right workDir -> do-          (exitCode, stdoutText, stderrText) <- runProcess "sh" ["-c", cv.run] workDir+          (exitCode, stdoutText, stderrText) <- runProcess "sh" ["-c", cv ^. #run] workDir           pure $ case exitCode of             ExitSuccess -> coerceCommandOutput decl cv stdoutText             ExitFailure code ->               Left $                 ValidationFailed-                  cv.name+                  (cv ^. #name)                   ( "command failed with exit code "                       <> T.pack (show code)                       <> ": "@@ -96,31 +97,31 @@     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))+        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+        if cv ^. #trim           then T.strip stdoutText           else stdoutText-  case cv.maxBytes of+  case cv ^. #maxBytes of     Just n       | fromIntegral (T.length output) > n ->-          Left (ValidationFailed cv.name ("command output exceeds maxBytes " <> T.pack (show n)))+          Left (ValidationFailed (cv ^. #name) ("command output exceeds maxBytes " <> T.pack (show n)))     _ -> do-      value <- coerceValue decl.name decl.type_ output+      value <- coerceValue (decl ^. #name) (decl ^. #type_) output       validateVarValue decl value       Right         ResolvedVar           { value = value,-            source = FromCommand cv.run,+            source = FromCommand (cv ^. #run),             decl = decl           }  resolvedValues :: Map VarName ResolvedVar -> Map VarName VarValue-resolvedValues = Map.map (.value)+resolvedValues = Map.map (^. #value)  summarizeDiagnostic :: Text -> Text summarizeDiagnostic t =

@@ -13,8 +13,8 @@   ) where +import Data.Generics.Labels () import Data.List (sortOn)-import GHC.Generics (Generic) import Seihou.Core.Version (Version, parseVersion) import Seihou.Prelude @@ -34,19 +34,19 @@ --     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}+  = 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]+  { from :: !Text,+    to :: !Text,+    ops :: ![MigrationOp]   }   deriving stock (Eq, Show, Generic) @@ -54,9 +54,9 @@ -- version strings use the same dotted-numeric format as module migrations, -- while 'prompt' describes only the changes needed for this edge. data BlueprintMigration = BlueprintMigration-  { from :: Text,-    to :: Text,-    prompt :: Text+  { from :: !Text,+    to :: !Text,+    prompt :: !Text   }   deriving stock (Eq, Show, Generic) @@ -85,20 +85,20 @@ -- -- 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+-- migrations that will run. A plan with @steps == []@ means the+-- manifest will advance from @from@ to @to@ without running -- any migration ops (a pure version bump). data MigrationPlan = MigrationPlan-  { planModule :: Text,+  { module_ :: !Text,     -- | Installed (manifest) version at the start.-    planFrom :: Version,+    from :: !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,+    -- bridge every gap inside @[from, to]@.+    to :: !Version,     -- | The migrations that actually apply, in ascending @from@     -- order. May be empty.-    planSteps :: [Migration]+    steps :: ![Migration]   }   deriving stock (Eq, Show, Generic) @@ -106,10 +106,10 @@ -- window. A non-trivial window may have no selected steps when the author -- declared no agent intervention for that range. data BlueprintMigrationPlan = BlueprintMigrationPlan-  { blueprintPlanName :: Text,-    blueprintPlanFrom :: Version,-    blueprintPlanTo :: Version,-    blueprintPlanSteps :: [BlueprintMigration]+  { name :: !Text,+    from :: !Version,+    to :: !Version,+    steps :: ![BlueprintMigration]   }   deriving stock (Eq, Show, Generic) @@ -168,14 +168,14 @@     ( fmap         ( \steps ->             MigrationPlan-              { planModule = modName,-                planFrom = installed,-                planTo = target,-                planSteps = steps+              { module_ = modName,+                from = installed,+                to = target,+                steps = steps               }         )     )-    (planMigrationWindow (.from) (.to) migrations installed target)+    (planMigrationWindow (^. #from) (^. #to) migrations installed target)  -- | Compute the ordered agent-guided migrations for a blueprint and version -- window. Selection and errors deliberately match 'planMigrationChain'.@@ -190,14 +190,14 @@     ( fmap         ( \steps ->             BlueprintMigrationPlan-              { blueprintPlanName = blueprintName,-                blueprintPlanFrom = current,-                blueprintPlanTo = target,-                blueprintPlanSteps = steps+              { name = blueprintName,+                from = current,+                to = target,+                steps = steps               }         )     )-    (planMigrationWindow (.from) (.to) migrations current target)+    (planMigrationWindow (^. #from) (^. #to) migrations current target)  -- | Shared gap-tolerant version-window planner. Keeping parsing, duplicate -- detection, ordering, overlap handling, and overshoot handling here prevents

@@ -31,10 +31,10 @@   ) where +import Data.Generics.Labels () 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)@@ -47,7 +47,7 @@ discoverModule :: [FilePath] -> ModuleName -> IO (Either ModuleLoadError FilePath) discoverModule searchPaths name = go searchPaths   where-    nameStr = T.unpack name.unModuleName+    nameStr = T.unpack (name ^. #unModuleName)     go [] = pure $ Left (ModuleNotFound name searchPaths)     go (dir : rest) = do       let candidate = dir </> nameStr@@ -70,7 +70,7 @@ discoverRunnable :: [FilePath] -> ModuleName -> IO (Either ModuleLoadError Runnable) discoverRunnable searchPaths name = go searchPaths   where-    nameStr = T.unpack name.unModuleName+    nameStr = T.unpack (name ^. #unModuleName)     go [] = pure $ Left (ModuleNotFound name searchPaths)     go (dir : rest) = do       let candidate = dir </> nameStr@@ -119,7 +119,7 @@ discoverBlueprint :: [FilePath] -> ModuleName -> IO (Either ModuleLoadError FilePath) discoverBlueprint searchPaths name = go searchPaths   where-    nameStr = T.unpack name.unModuleName+    nameStr = T.unpack (name ^. #unModuleName)     go [] = pure $ Left (ModuleNotFound name searchPaths)     go (dir : rest) = do       let candidate = dir </> nameStr@@ -135,7 +135,7 @@ discoverAgentPrompt :: [FilePath] -> ModuleName -> IO (Either ModuleLoadError FilePath) discoverAgentPrompt searchPaths name = go searchPaths   where-    nameStr = T.unpack name.unModuleName+    nameStr = T.unpack (name ^. #unModuleName)     go [] = pure $ Left (ModuleNotFound name searchPaths)     go (dir : rest) = do       let candidate = dir </> nameStr@@ -181,12 +181,12 @@   pure $     if null allErrors       then Right m-      else Left (ValidationError m.name allErrors)+      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+  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 []@@ -200,7 +200,7 @@  -- Rule 1b: Module must declare a version checkVersionPresent :: Module -> [Text]-checkVersionPresent m = case m.version of+checkVersionPresent m = case m ^. #version of   Nothing -> ["module must declare a version"]   Just v     | T.null (T.strip v) -> ["module must declare a version"]@@ -209,7 +209,7 @@ -- Rule 2: All variable names must be unique checkUniqueVars :: Module -> [Text] checkUniqueVars m =-  let names = map (\d -> d.name.unVarName) m.vars+  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]@@ -221,14 +221,14 @@ -- Rule 3: Every prompt must reference a declared variable checkPromptRefs :: Module -> [Text] checkPromptRefs m =-  let varNames = Set.fromList (map (.name) m.vars)+  let varNames = Set.fromList (map (^. #name) (m ^. #vars))    in concatMap         ( \p ->-            if Set.member p.var varNames+            if Set.member (p ^. #var) varNames               then []-              else ["prompt references undeclared variable: " <> p.var.unVarName]+              else ["prompt references undeclared variable: " <> p ^. #var . #unVarName]         )-        m.prompts+        (m ^. #prompts)  -- Rule 4: Every step source file must exist in the module's files/ directory checkFileExistence :: FilePath -> Module -> IO [Text]@@ -236,38 +236,38 @@   concat     <$> mapM       ( \s -> do-          let p = baseDir </> "files" </> s.src+          let p = baseDir </> "files" </> (s ^. #src)           exists <- doesFileExist p           pure $             if exists               then []-              else ["step source file not found: " <> T.pack s.src]+              else ["step source file not found: " <> T.pack (s ^. #src)]       )-      m.steps+      (m ^. #steps)  -- Rule 5: Every export must reference a declared variable checkExportRefs :: Module -> [Text] checkExportRefs m =-  let varNames = Set.fromList (map (.name) m.vars)+  let varNames = Set.fromList (map (^. #name) (m ^. #vars))    in concatMap         ( \e ->-            if Set.member e.var varNames+            if Set.member (e ^. #var) varNames               then []-              else ["export references undeclared variable: " <> e.var.unVarName]+              else ["export references undeclared variable: " <> e ^. #var . #unVarName]         )-        m.exports+        (m ^. #exports)  -- Rule 6: Every dependency name must be well-formed checkDependencyNames :: Module -> [Text] checkDependencyNames m =   concatMap     ( \dep ->-        let n = dep.depModule.unModuleName+        let n = (dep ^. #module_ . #unModuleName)          in if isValidModuleName n               then []               else ["invalid dependency name: " <> n]     )-    m.dependencies+    (m ^. #dependencies)  -- Rule 6b: Dependency var binding names must be non-empty checkDependencyVarBindings :: Module -> [Text]@@ -277,42 +277,42 @@         concatMap           ( \(VarName vn) ->               if T.null vn-                then ["dependency '" <> dep.depModule.unModuleName <> "' has empty var binding name"]+                then ["dependency '" <> dep ^. #module_ . #unModuleName <> "' has empty var binding name"]                 else []           )-          (Map.keys dep.depVars)+          (Map.keys (dep ^. #vars))     )-    m.dependencies+    (m ^. #dependencies)  -- Rule 7: Every step destination must be a safe relative path checkSafeDestinations :: Module -> [Text]-checkSafeDestinations m = concatMap checkDest m.steps+checkSafeDestinations m = concatMap checkDest (m ^. #steps)   where     checkDest s =-      case validateProjectRelativePath s.dest of+      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+  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,+      | 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+checkCommandSafety m = concatMap checkCmd (m ^. #commands)   where-    checkCmd c = checkEmptyRun c <> checkWorkDir c.workDir+    checkCmd c = checkEmptyRun c <> checkWorkDir (c ^. #workDir)      checkEmptyRun c-      | T.null (T.strip c.run) = ["command text must not be empty"]+      | T.null (T.strip (c ^. #run)) = ["command text must not be empty"]       | otherwise = []      checkWorkDir Nothing = []@@ -352,11 +352,11 @@  -- | A module discovered during enumeration, with its load result and source. data DiscoveredModule = DiscoveredModule-  { discoveredResult :: Either ModuleLoadError Module,-    discoveredSource :: ModuleSource,-    discoveredDir :: FilePath+  { result :: !(Either ModuleLoadError Module),+    source :: !ModuleSource,+    dir :: !FilePath   }-  deriving stock (Show)+  deriving stock (Generic, Show)  -- | Enumerate all modules across the given search paths. -- The search paths must be in the same order as 'defaultSearchPaths':@@ -399,7 +399,7 @@       result <- case decoded of         Left err -> pure (Left err)         Right m -> validateModule moduleDir m-      pure DiscoveredModule {discoveredResult = result, discoveredSource = src, discoveredDir = moduleDir}+      pure DiscoveredModule {result = result, source = src, dir = moduleDir}  -- | Whether a discovered item is a module, recipe, blueprint, or prompt. data RunnableKind = KindModule | KindRecipe | KindBlueprint | KindPrompt@@ -407,15 +407,15 @@  -- | 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+  { name :: !Text,+    description :: !(Maybe Text),+    kind :: !RunnableKind,+    source :: !ModuleSource,+    dir :: !FilePath,+    isError :: !Bool,+    error :: !(Maybe Text)   }-  deriving stock (Show)+  deriving stock (Generic, 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.@@ -453,23 +453,23 @@             [ case decoded of                 Left err ->                   DiscoveredRunnable-                    { drName = T.pack entry,-                      drDescription = Nothing,-                      drKind = KindModule,-                      drSource = src,-                      drDir = entryDir,-                      drIsError = True,-                      drError = Just (briefLoadError err)+                    { name = T.pack entry,+                      description = Nothing,+                      kind = KindModule,+                      source = src,+                      dir = entryDir,+                      isError = True,+                      error = Just (briefLoadError err)                     }                 Right m ->                   DiscoveredRunnable-                    { drName = m.name.unModuleName,-                      drDescription = m.description,-                      drKind = KindModule,-                      drSource = src,-                      drDir = entryDir,-                      drIsError = False,-                      drError = Nothing+                    { name = m ^. #name . #unModuleName,+                      description = m ^. #description,+                      kind = KindModule,+                      source = src,+                      dir = entryDir,+                      isError = False,+                      error = Nothing                     }             ]         else@@ -480,23 +480,23 @@                 [ case decoded of                     Left err ->                       DiscoveredRunnable-                        { drName = T.pack entry,-                          drDescription = Nothing,-                          drKind = KindRecipe,-                          drSource = src,-                          drDir = entryDir,-                          drIsError = True,-                          drError = Just (briefLoadError err)+                        { name = T.pack entry,+                          description = Nothing,+                          kind = KindRecipe,+                          source = src,+                          dir = entryDir,+                          isError = True,+                          error = Just (briefLoadError err)                         }                     Right r ->                       DiscoveredRunnable-                        { drName = r.name.unRecipeName,-                          drDescription = r.description,-                          drKind = KindRecipe,-                          drSource = src,-                          drDir = entryDir,-                          drIsError = False,-                          drError = Nothing+                        { name = r ^. #name . #unRecipeName,+                          description = r ^. #description,+                          kind = KindRecipe,+                          source = src,+                          dir = entryDir,+                          isError = False,+                          error = Nothing                         }                 ]             else@@ -507,23 +507,23 @@                     [ case decoded of                         Left err ->                           DiscoveredRunnable-                            { drName = T.pack entry,-                              drDescription = Nothing,-                              drKind = KindBlueprint,-                              drSource = src,-                              drDir = entryDir,-                              drIsError = True,-                              drError = Just (briefLoadError err)+                            { name = T.pack entry,+                              description = Nothing,+                              kind = KindBlueprint,+                              source = src,+                              dir = entryDir,+                              isError = True,+                              error = Just (briefLoadError err)                             }                         Right b ->                           DiscoveredRunnable-                            { drName = b.name.unModuleName,-                              drDescription = b.description,-                              drKind = KindBlueprint,-                              drSource = src,-                              drDir = entryDir,-                              drIsError = False,-                              drError = Nothing+                            { name = b ^. #name . #unModuleName,+                              description = b ^. #description,+                              kind = KindBlueprint,+                              source = src,+                              dir = entryDir,+                              isError = False,+                              error = Nothing                             }                     ]                 else@@ -534,23 +534,23 @@                         [ case decoded of                             Left err ->                               DiscoveredRunnable-                                { drName = T.pack entry,-                                  drDescription = Nothing,-                                  drKind = KindPrompt,-                                  drSource = src,-                                  drDir = entryDir,-                                  drIsError = True,-                                  drError = Just (briefLoadError err)+                                { name = T.pack entry,+                                  description = Nothing,+                                  kind = KindPrompt,+                                  source = src,+                                  dir = entryDir,+                                  isError = True,+                                  error = Just (briefLoadError err)                                 }                             Right p ->                               DiscoveredRunnable-                                { drName = p.name.unModuleName,-                                  drDescription = p.description,-                                  drKind = KindPrompt,-                                  drSource = src,-                                  drDir = entryDir,-                                  drIsError = False,-                                  drError = Nothing+                                { name = p ^. #name . #unModuleName,+                                  description = p ^. #description,+                                  kind = KindPrompt,+                                  source = src,+                                  dir = entryDir,+                                  isError = False,+                                  error = Nothing                                 }                         ]                     else pure []

@@ -3,6 +3,8 @@   ) where +import Control.Lens ((^.))+import Data.Generics.Labels () import Data.Map.Strict qualified as Map import Data.Set qualified as Set import Data.Text (Text)@@ -33,7 +35,7 @@ -- Rule 1: Recipe name must match [a-z][a-z0-9-]* checkRecipeNameFormat :: Recipe -> [Text] checkRecipeNameFormat recipe =-  let n = recipe.name.unRecipeName+  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 []@@ -41,13 +43,13 @@ -- Rule 2: At least one module must be listed checkNonEmptyModules :: Recipe -> [Text] checkNonEmptyModules recipe-  | null recipe.modules = ["recipe must list at least one module"]+  | null (recipe ^. #modules) = ["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+  let names = map (^. #module_ . #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]@@ -59,16 +61,16 @@ -- Rule 4: Variable binding names must match [a-z][a-z0-9.-]* checkVarBindingNames :: Recipe -> [Text] checkVarBindingNames recipe =-  concatMap checkDep recipe.modules+  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 <> "'"]+              else ["invalid var binding name '" <> vn <> "' in module '" <> dep ^. #module_ . #unModuleName <> "'"]         )-        (Map.keys dep.depVars)+        (Map.keys (dep ^. #vars))      isValidVarBindingName :: Text -> Bool     isValidVarBindingName t = case T.uncons t of

@@ -19,31 +19,31 @@   ) where +import Data.Generics.Labels () 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]+  { 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]+  { repoName :: !Text,+    repoDescription :: !(Maybe Text),+    modules :: ![RegistryEntry],+    recipes :: ![RegistryEntry],+    blueprints :: ![RegistryEntry],+    prompts :: ![RegistryEntry]   }   deriving stock (Eq, Show, Generic) @@ -114,20 +114,20 @@ -- 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+  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+  let nameText = (entry ^. #name . #unModuleName)       nameErrors = checkName nameText-      pathText = T.pack entry.path+      pathText = T.pack (entry ^. #path)       pathErrors = checkPath pathText-  let moduleDhall = repoRoot </> entry.path </> "module.dhall"+  let moduleDhall = repoRoot </> entry ^. #path </> "module.dhall"   fileExists <- doesFileExist moduleDhall   let fileErrors =         if fileExists@@ -146,11 +146,11 @@  validateRecipeEntry :: FilePath -> RegistryEntry -> IO [Text] validateRecipeEntry repoRoot entry = do-  let nameText = entry.name.unModuleName+  let nameText = (entry ^. #name . #unModuleName)       nameErrors = checkRecipeName nameText-      pathText = T.pack entry.path+      pathText = T.pack (entry ^. #path)       pathErrors = checkRecipePath pathText-  let recipeDhall = repoRoot </> entry.path </> "recipe.dhall"+  let recipeDhall = repoRoot </> entry ^. #path </> "recipe.dhall"   fileExists <- doesFileExist recipeDhall   let fileErrors =         if fileExists@@ -169,11 +169,11 @@  validateBlueprintEntry :: FilePath -> RegistryEntry -> IO [Text] validateBlueprintEntry repoRoot entry = do-  let nameText = entry.name.unModuleName+  let nameText = (entry ^. #name . #unModuleName)       nameErrors = checkBlueprintName nameText-      pathText = T.pack entry.path+      pathText = T.pack (entry ^. #path)       pathErrors = checkBlueprintPath pathText-  let blueprintDhall = repoRoot </> entry.path </> "blueprint.dhall"+  let blueprintDhall = repoRoot </> entry ^. #path </> "blueprint.dhall"   fileExists <- doesFileExist blueprintDhall   let fileErrors =         if fileExists@@ -192,11 +192,11 @@  validatePromptEntry :: FilePath -> RegistryEntry -> IO [Text] validatePromptEntry repoRoot entry = do-  let nameText = entry.name.unModuleName+  let nameText = (entry ^. #name . #unModuleName)       nameErrors = checkPromptName nameText-      pathText = T.pack entry.path+      pathText = T.pack (entry ^. #path)       pathErrors = checkPromptPath pathText-  let promptDhall = repoRoot </> entry.path </> "prompt.dhall"+  let promptDhall = repoRoot </> entry ^. #path </> "prompt.dhall"   fileExists <- doesFileExist promptDhall   let fileErrors =         if fileExists@@ -218,10 +218,10 @@ -- 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+  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]@@ -265,11 +265,11 @@  -- | One row of a sync diff, preserving registry order. data SyncDiff = SyncDiff-  { diffKind :: EntryKind,-    diffName :: ModuleName,-    diffOld :: Maybe Text,-    diffNew :: Maybe Text,-    diffStatus :: SyncStatus+  { kind :: !EntryKind,+    name :: !ModuleName,+    old :: !(Maybe Text),+    new :: !(Maybe Text),+    status :: !SyncStatus   }   deriving stock (Eq, Show, Generic) @@ -277,8 +277,8 @@ -- 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+  { diffs :: ![SyncDiff],+    updated :: !Registry   }   deriving stock (Eq, Show, Generic) @@ -295,25 +295,28 @@   SyncReport computeRegistrySync reg lookups =   SyncReport-    { syncDiffs = moduleDiffs <> recipeDiffs <> blueprintDiffs <> promptDiffs,-      syncUpdated =+    { diffs = moduleDiffs <> recipeDiffs <> blueprintDiffs <> promptDiffs,+      updated =         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-          }+          & #modules+          %~ zipWith applyDiff moduleDiffs+          & #recipes+          %~ zipWith applyDiff recipeDiffs+          & #blueprints+          %~ zipWith applyDiff blueprintDiffs+          & #prompts+          %~ zipWith applyDiff promptDiffs     }   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+    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+      let onDisk = lookupOnDisk kind (entry ^. #name)+          status = case (entry ^. #version, onDisk) of             (_, OnDiskMissing) -> SyncOrphan             (Nothing, OnDiskValue Nothing) -> SyncInSync             (Nothing, OnDiskValue (Just _)) -> SyncMissing@@ -322,20 +325,20 @@               | old == new -> SyncInSync               | otherwise -> SyncStale new           newVersion = case onDisk of-            OnDiskMissing -> entry.version+            OnDiskMissing -> (entry ^. #version)             OnDiskValue v -> v        in SyncDiff-            { diffKind = kind,-              diffName = entry.name,-              diffOld = entry.version,-              diffNew = newVersion,-              diffStatus = status+            { kind = kind,+              name = entry ^. #name,+              old = entry ^. #version,+              new = newVersion,+              status = status             }      applyDiff :: SyncDiff -> RegistryEntry -> RegistryEntry-    applyDiff diff entry = case diff.diffStatus of+    applyDiff diff entry = case diff ^. #status of       SyncOrphan -> entry-      _ -> entry {version = diff.diffNew}+      _ -> entry & #version .~ diff ^. #new      lookupOnDisk :: EntryKind -> ModuleName -> OnDiskVersion     lookupOnDisk kind name =@@ -352,28 +355,28 @@ -- '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+formatDriftWarning diff = case diff ^. #status of   SyncInSync -> Nothing   SyncOrphan -> Nothing   SyncMissing ->     Just $-      kindWord diff.diffKind+      kindWord (diff ^. #kind)         <> " '"-        <> diff.diffName.unModuleName+        <> diff ^. #name . #unModuleName         <> "' registry version is missing; "-        <> entryFile diff.diffKind+        <> entryFile (diff ^. #kind)         <> " declares "-        <> renderVersion diff.diffNew+        <> renderVersion (diff ^. #new)         <> " — run `seihou registry sync-versions`"   SyncStale newVer ->     Just $-      kindWord diff.diffKind+      kindWord (diff ^. #kind)         <> " '"-        <> diff.diffName.unModuleName+        <> diff ^. #name . #unModuleName         <> "' registry version "-        <> renderVersion diff.diffOld+        <> renderVersion (diff ^. #old)         <> " differs from "-        <> entryFile diff.diffKind+        <> entryFile (diff ^. #kind)         <> " version "         <> newVer         <> " — run `seihou registry sync-versions`"@@ -400,17 +403,17 @@ -- | 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+  { issues :: ![RegistryValidationIssue],+    moduleCount :: !Int,+    recipeCount :: !Int,+    blueprintCount :: !Int,+    promptCount :: !Int   }   deriving stock (Eq, Show, Generic)  -- | True iff the report has at least one issue. reportHasIssues :: RegistryValidationReport -> Bool-reportHasIssues r = not (null r.reportIssues)+reportHasIssues r = not (null (r ^. #issues))  -- | Combine the existing structural checks with version classification. -- The third argument is the same shape 'computeRegistrySync' takes —@@ -426,16 +429,16 @@   let report = computeRegistrySync reg lookups       versionIssues =         [ VersionMismatch d-        | d <- report.syncDiffs,-          isVersionDrift d.diffStatus+        | d <- report ^. #diffs,+          isVersionDrift (d ^. #status)         ]   pure     RegistryValidationReport-      { reportIssues = map StructuralError structuralErrs <> versionIssues,-        reportModuleCount = length reg.modules,-        reportRecipeCount = length reg.recipes,-        reportBlueprintCount = length reg.blueprints,-        reportPromptCount = length reg.prompts+      { issues = map StructuralError structuralErrs <> versionIssues,+        moduleCount = length (reg ^. #modules),+        recipeCount = length (reg ^. #recipes),+        blueprintCount = length (reg ^. #blueprints),+        promptCount = length (reg ^. #prompts)       }   where     isVersionDrift SyncMissing = True@@ -450,14 +453,14 @@ formatValidationIssue :: RegistryValidationIssue -> Text formatValidationIssue (StructuralError msg) = msg formatValidationIssue (VersionMismatch diff) =-  validationKindPrefix diff.diffKind-    <> diff.diffName.unModuleName+  validationKindPrefix (diff ^. #kind)+    <> diff ^. #name . #unModuleName     <> ": registry version "-    <> validationRenderVersion diff.diffOld+    <> validationRenderVersion (diff ^. #old)     <> " does not match "-    <> entryFile diff.diffKind+    <> entryFile (diff ^. #kind)     <> " version "-    <> validationRenderVersion diff.diffNew+    <> validationRenderVersion (diff ^. #new)   where     entryFile ModuleEntry = "module.dhall"     entryFile RecipeEntry = "recipe.dhall"@@ -480,16 +483,16 @@ renderRegistryDhall :: Registry -> Text renderRegistryDhall reg =   T.unlines-    [ "{ repoName = " <> renderString reg.repoName,-      ", repoDescription = " <> renderOptionalText reg.repoDescription,+    [ "{ repoName = " <> renderString (reg ^. #repoName),+      ", repoDescription = " <> renderOptionalText (reg ^. #repoDescription),       ", modules =",-      renderEntryList reg.modules,+      renderEntryList (reg ^. #modules),       ", recipes =",-      renderEntryList reg.recipes,+      renderEntryList (reg ^. #recipes),       ", blueprints =",-      renderEntryList reg.blueprints,+      renderEntryList (reg ^. #blueprints),       ", prompts =",-      renderEntryList reg.prompts,+      renderEntryList (reg ^. #prompts),       "}"     ] @@ -505,11 +508,11 @@ 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,+    [ "  " <> 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

@@ -87,6 +87,10 @@       "    , files = [] : List S.Blueprint.BlueprintFile.Type",       "    , migrations = [] : List S.BlueprintMigration.Type",       "    , tags = [] : List Text",+      "      -- Optional: declare the agent this blueprint was written for.",+      "      -- These override the invoking user's config files but lose to a",+      "      -- --provider / --model / --effort flag or a SEIHOU_AGENT_* variable.",+      "      -- , launch = Some S.Launch::{ effort = Some \"max\" }",       "    }"     ] 

@@ -3,6 +3,7 @@   ) where +import Data.Generics.Labels () import Data.List (sortOn) import Data.Map.Strict qualified as Map import Seihou.Core.Types@@ -16,8 +17,8 @@ -- '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)+  results <- mapM classifyFile (Map.toAscList (manifest ^. #files))+  pure (sortOn (^. #path) results)   where     classifyFile :: (Filesystem :> es') => (FilePath, FileRecord) -> Eff es' TrackedFile     classifyFile (path, record) = do@@ -29,13 +30,13 @@             content <- readFileText path             let diskHash = hashContent content             pure-              ( if diskHash == record.hash+              ( if diskHash == record ^. #hash                   then TfsUnchanged                   else TfsModified               )       pure         TrackedFile           { path = path,-            moduleName = record.moduleName,+            moduleName = record ^. #moduleName,             status = status           }

@@ -28,7 +28,7 @@     Blueprint (..),     CommandVar (..),     PromptGuidance (..),-    AgentPromptLaunch (..),+    AgentLaunch (..),     AgentPrompt (..),     Runnable (..),     recipeNameToModuleName,@@ -36,6 +36,7 @@     ModuleLoadError (..),     Manifest (..),     ApplicationId (..),+    ArtifactOrigin (..),     AppliedTarget (..),     BaselineRef (..),     CommandFingerprint (..),@@ -67,6 +68,8 @@   ) where +import Control.Lens ((^.))+import Data.Generics.Labels () import Data.Map.Strict (Map) import Data.Set (Set) import Data.String (IsString)@@ -113,28 +116,28 @@  -- | A variable declaration within a module. data VarDecl = VarDecl-  { name :: VarName,-    type_ :: VarType,-    default_ :: Maybe VarValue,-    description :: Maybe Text,-    required :: Bool,-    validation :: Maybe Validation+  { 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+  { 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]+  { var :: !VarName,+    text :: !Text,+    condition :: !(Maybe Expr),+    choices :: !(Maybe [Text])   }   deriving stock (Eq, Show, Generic) @@ -170,43 +173,43 @@  -- | A generation step within a module. data Step = Step-  { strategy :: Strategy,-    src :: FilePath,-    dest :: Text,-    condition :: Maybe Expr,-    patch :: Maybe PatchOp+  { 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+  { 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+-- When @vars@ 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+  { module_ :: !ModuleName,+    vars :: !(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}+simpleDep name = Dependency {module_ = name, vars = mempty}  -- | Extract module names from a list of dependencies. depModuleNames :: [Dependency] -> [ModuleName]-depModuleNames = map (.depModule)+depModuleNames = map (^. #module_)  -- | 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,+-- 'ModuleInstance' is determined by the @vars@ the parent supplied, -- not by anything resolved downstream. -- -- The underlying 'Data.Map.Strict' @Ord@ instance gives structural equality:@@ -221,9 +224,9 @@ emptyParentVars :: ParentVars emptyParentVars = ParentVars mempty --- | Build 'ParentVars' from a 'Dependency' record's @depVars@ field.+-- | Build 'ParentVars' from a 'Dependency' record's @vars@ field. parentVarsFromDep :: Dependency -> ParentVars-parentVarsFromDep dep = ParentVars dep.depVars+parentVarsFromDep dep = ParentVars (dep ^. #vars)  -- | The type of removal action for a removal step. data RemovalAction@@ -237,32 +240,32 @@  -- | A single removal step describing how to reverse one effect of a module. data RemovalStep = RemovalStep-  { action :: RemovalAction,-    dest :: Text,-    src :: Maybe FilePath+  { action :: !RemovalAction,+    dest :: !Text,+    src :: !(Maybe FilePath)   }   deriving stock (Eq, Show, Generic)  -- | Removal specification for a module. data Removal = Removal-  { removalSteps :: [RemovalStep],-    removalCommands :: [Command]+  { steps :: ![RemovalStep],+    commands :: ![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]+  { 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) @@ -275,12 +278,12 @@ -- | 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]+  { name :: !RecipeName,+    version :: !(Maybe Text),+    description :: !(Maybe Text),+    modules :: ![Dependency],+    vars :: ![VarDecl],+    prompts :: ![Prompt]   }   deriving stock (Eq, Show, Generic) @@ -289,8 +292,8 @@ -- 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+  { src :: !FilePath,+    description :: !(Maybe Text)   }   deriving stock (Eq, Show, Generic) @@ -300,17 +303,18 @@ -- 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],-    migrations :: [BlueprintMigration]+  { name :: !ModuleName,+    version :: !(Maybe Text),+    description :: !(Maybe Text),+    prompt :: !Text,+    vars :: ![VarDecl],+    prompts :: ![Prompt],+    baseModules :: ![Dependency],+    files :: ![BlueprintFile],+    allowedTools :: !(Maybe [Text]),+    tags :: ![Text],+    migrations :: ![BlueprintMigration],+    launch :: !(Maybe AgentLaunch)   }   deriving stock (Eq, Show, Generic) @@ -318,31 +322,37 @@ -- 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+  { 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+  { 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+-- | Optional launch preferences declared by an agent-driven artifact (a+-- 'Blueprint' or an 'AgentPrompt'). Values are raw text here; the CLI parses+-- and validates them, because the provider and effort vocabularies live in the+-- CLI layer. 'mode' is reserved and currently ignored.+--+-- Declared values override the invoking user's configuration files but lose to+-- a @--provider@ \/ @--model@ \/ @--effort@ flag and to the @SEIHOU_AGENT_*@+-- environment variables.+data AgentLaunch = AgentLaunch+  { provider :: !(Maybe Text),+    model :: !(Maybe Text),+    effort :: !(Maybe Text),+    mode :: !(Maybe Text)   }   deriving stock (Eq, Show, Generic) @@ -350,18 +360,18 @@ -- 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+  { 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 AgentLaunch)   }   deriving stock (Eq, Show, Generic) @@ -380,29 +390,29 @@ -- | Filesystem operations produced by the generation engine. data Operation   = WriteFileOp-      { dest :: FilePath,-        content :: Text,-        strategy :: Strategy+      { dest :: !FilePath,+        content :: !Text,+        strategy :: !Strategy       }   | CreateDirOp-      { path :: FilePath+      { path :: !FilePath       }   | CopyFileOp-      { src :: FilePath,-        dest :: FilePath+      { src :: !FilePath,+        dest :: !FilePath       }   | RunCommandOp-      { command :: Text,-        workDir :: Maybe FilePath,-        moduleName :: ModuleName,-        occurrence :: Int+      { command :: !Text,+        workDir :: !(Maybe FilePath),+        moduleName :: !ModuleName,+        occurrence :: !Int       }   | PatchFileOp-      { dest :: FilePath,-        content :: Text,-        op :: PatchOp,-        strategy :: Strategy,-        moduleName :: ModuleName+      { dest :: !FilePath,+        content :: !Text,+        op :: !PatchOp,+        strategy :: !Strategy,+        moduleName :: !ModuleName       }   deriving stock (Eq, Show, Generic) @@ -434,9 +444,9 @@  -- | A variable that has been resolved to a concrete value with provenance. data ResolvedVar = ResolvedVar-  { value :: VarValue,-    source :: VarSource,-    decl :: VarDecl+  { value :: !VarValue,+    source :: !VarSource,+    decl :: !VarDecl   }   deriving stock (Eq, Show, Generic) @@ -465,15 +475,15 @@ -- | 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,-    applications :: [AppliedComposition],-    recipe :: Maybe AppliedRecipe,-    blueprint :: Maybe AppliedBlueprint,-    blueprintMigrations :: [AppliedBlueprintMigration]+  { version :: !Int,+    genAt :: !UTCTime,+    modules :: ![AppliedModule],+    vars :: !(Map VarName Text),+    files :: !(Map FilePath FileRecord),+    applications :: ![AppliedComposition],+    recipe :: !(Maybe AppliedRecipe),+    blueprint :: !(Maybe AppliedBlueprint),+    blueprintMigrations :: ![AppliedBlueprintMigration]   }   deriving stock (Eq, Show, Generic) @@ -481,6 +491,43 @@ newtype ApplicationId = ApplicationId {unApplicationId :: Text}   deriving stock (Eq, Ord, Show, Generic) +-- | Machine-independent identity of an artifact recorded in the manifest.+--+-- The manifest is checked into version control and shared between+-- developers, so it must never contain a path that is meaningful only on+-- the machine that wrote it. Every artifact reference is therefore one of+-- three cases, distinguished by how much provenance seihou can actually+-- prove.+--+-- 'RemoteOrigin' is the strong case: the artifact was installed by+-- @seihou install@ from a git URL into+-- @~\/.config\/seihou\/installed\/\<name\>@, and that URL was recorded in+-- @.seihou-origin.json@ beside it. Two developers who install from the+-- same URL are provably using the same upstream artifact.+--+-- 'ProjectOrigin' is the case where the artifact lives inside the project+-- itself, under @.seihou\/modules\/\<name\>@. The path is stored relative+-- to the project root, so it means the same thing in every clone.+--+-- 'LocalOrigin' is the weak case: the artifact was found in the+-- developer's personal @~\/.config\/seihou\/modules\/@ directory, which+-- carries no provenance metadata at all. Only the name is knowable.+-- Recording it honestly, rather than fabricating a URL, lets later+-- verification report that this artifact's provenance cannot be checked.+data ArtifactOrigin+  = RemoteOrigin+      { originUrl :: !Text,+        artifactName :: !Text,+        repoName :: !(Maybe Text)+      }+  | ProjectOrigin+      { relativePath :: !FilePath+      }+  | LocalOrigin+      { artifactName :: !Text+      }+  deriving stock (Eq, Ord, Show, Generic)+ -- | The deterministic artifact originally requested by the user. data AppliedTarget   = AppliedModuleTarget ModuleName@@ -497,44 +544,48 @@  -- | Evidence that one rendered command completed successfully. data CommandReceipt = CommandReceipt-  { fingerprint :: CommandFingerprint,-    moduleName :: ModuleName,-    command :: Text,-    workDir :: Maybe FilePath,-    completedAt :: UTCTime+  { fingerprint :: !CommandFingerprint,+    moduleName :: !ModuleName,+    command :: !Text,+    workDir :: !(Maybe FilePath),+    completedAt :: !UTCTime   }   deriving stock (Eq, Show, Generic)  -- | Reproducible state for one module instance in an application.+--+-- @origin@ is the module's portable identity. Turning it back into a+-- directory on the current machine is 'Seihou.Core.ArtifactRef.resolveArtifactOrigin';+-- no path is ever recorded here. data AppliedInstanceState = AppliedInstanceState-  { name :: ModuleName,-    parentVars :: ParentVars,-    source :: FilePath,-    moduleVersion :: Maybe Text,-    resolvedVars :: Map VarName Text+  { name :: !ModuleName,+    parentVars :: !ParentVars,+    origin :: !ArtifactOrigin,+    moduleVersion :: !(Maybe Text),+    resolvedVars :: !(Map VarName Text)   }   deriving stock (Eq, Show, Generic)  -- | A complete, re-runnable top-level module or recipe composition. data AppliedComposition = AppliedComposition-  { applicationId :: ApplicationId,-    target :: AppliedTarget,-    targetSource :: FilePath,-    targetVersion :: Maybe Text,-    additionalModules :: [ModuleName],-    namespace :: Maybe Text,-    context :: Maybe Text,-    instances :: [AppliedInstanceState],-    commandReceipts :: Map CommandFingerprint CommandReceipt,-    appliedAt :: UTCTime+  { applicationId :: !ApplicationId,+    target :: !AppliedTarget,+    targetOrigin :: !ArtifactOrigin,+    targetVersion :: !(Maybe Text),+    additionalModules :: ![ModuleName],+    namespace :: !(Maybe Text),+    context :: !(Maybe Text),+    instances :: ![AppliedInstanceState],+    commandReceipts :: !(Map CommandFingerprint CommandReceipt),+    appliedAt :: !UTCTime   }   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+  { name :: !RecipeName,+    recipeVersion :: !(Maybe Text),+    appliedAt :: !UTCTime   }   deriving stock (Eq, Show, Generic) @@ -552,13 +603,13 @@ -- 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+  { name :: !ModuleName,+    blueprintVersion :: !(Maybe Text),+    appliedAt :: !UTCTime,+    baselineModules :: ![ModuleName],+    noBaseline :: !Bool,+    userPrompt :: !(Maybe Text),+    agentSessionId :: !(Maybe Text)   }   deriving stock (Eq, Show, Generic) @@ -566,12 +617,12 @@ -- migration edge. Exact-edge identity is the blueprint 'name' together with -- 'fromVersion' and 'toVersion'; the remaining fields are audit metadata. data AppliedBlueprintMigration = AppliedBlueprintMigration-  { name :: ModuleName,-    blueprintVersion :: Maybe Text,-    fromVersion :: Text,-    toVersion :: Text,-    appliedAt :: UTCTime,-    agentSessionId :: Maybe Text+  { name :: !ModuleName,+    blueprintVersion :: !(Maybe Text),+    fromVersion :: !Text,+    toVersion :: !Text,+    appliedAt :: !UTCTime,+    agentSessionId :: !(Maybe Text)   }   deriving stock (Eq, Show, Generic) @@ -582,24 +633,29 @@ -- the same @name@ and different @parentVars@ represent two legitimate -- instances. Manifests produced before schema version 2 decode with -- @parentVars = 'emptyParentVars'@.+--+-- @origin@ is the module's portable identity. Turning it back into a+-- directory on the current machine is+-- 'Seihou.Core.ArtifactRef.resolveArtifactOrigin'; no path is ever recorded+-- here. data AppliedModule = AppliedModule-  { name :: ModuleName,-    parentVars :: ParentVars,-    source :: FilePath,-    moduleVersion :: Maybe Text,-    appliedAt :: UTCTime,-    removal :: Maybe Removal+  { name :: !ModuleName,+    parentVars :: !ParentVars,+    origin :: !ArtifactOrigin,+    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,-    baseline :: Maybe BaselineRef,-    applicationIds :: Set ApplicationId+  { hash :: !SHA256,+    moduleName :: !ModuleName,+    strategy :: !Strategy,+    generatedAt :: !UTCTime,+    baseline :: !(Maybe BaselineRef),+    applicationIds :: !(Set ApplicationId)   }   deriving stock (Eq, Show, Generic) @@ -610,47 +666,47 @@  -- | Result of the three-state diff: manifest vs plan vs disk. data DiffResult = DiffResult-  { new :: [PlannedFile],-    modified :: [ModifiedFile],-    unchanged :: [FilePath],-    conflicts :: [ConflictFile],-    orphaned :: [OrphanedFile]+  { 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+  { 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+  { 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+  { 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+  { path :: !FilePath,+    moduleName :: !ModuleName   }   deriving stock (Eq, Show, Generic) @@ -705,8 +761,8 @@  -- | A tracked file with its path, originating module, and disk status. data TrackedFile = TrackedFile-  { path :: FilePath,-    moduleName :: ModuleName,-    status :: TrackedFileStatus+  { path :: !FilePath,+    moduleName :: !ModuleName,+    status :: !TrackedFileStatus   }   deriving stock (Eq, Show, Generic)

@@ -12,6 +12,7 @@ where  import Data.Char (toUpper)+import Data.Generics.Labels () import Data.Map.Strict qualified as Map import Data.Maybe (catMaybes) import Data.Set qualified as Set@@ -69,9 +70,9 @@ -- | Validate a resolved value against its declaration's validation constraint. validateVarValue :: VarDecl -> VarValue -> Either VarError () validateVarValue decl val =-  case decl.validation of+  case decl ^. #validation of     Nothing -> Right ()-    Just v -> checkValidation decl.name v val+    Just v -> checkValidation (decl ^. #name) v val  checkValidation :: VarName -> Validation -> VarValue -> Either VarError () checkValidation name (ValPattern pat) (VText t) =@@ -185,8 +186,8 @@   where     resolveOne :: VarDecl -> Either VarError (Maybe (VarName, ResolvedVar))     resolveOne decl =-      let name = decl.name-          ty = decl.type_+      let name = (decl ^. #name)+          ty = (decl ^. #type_)        in case lookupCLI name ty of             Just result -> fmap Just (result >>= validateAndWrap decl)             Nothing -> case lookupSaved name ty of@@ -203,13 +204,13 @@                         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+                          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)+                              | decl ^. #required -> Left (MissingRequiredVar name)                               | otherwise -> Right Nothing      lookupSaved :: VarName -> VarType -> Maybe (Either VarError (VarValue, VarSource))@@ -264,7 +265,7 @@         Left err -> Left err         Right () ->           Right-            ( decl.name,+            ( decl ^. #name,               ResolvedVar                 { value = val,                   source = source,@@ -289,14 +290,14 @@      -- 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)+    maxValueLen = maximum (0 : map (\(_, rv) -> T.length (showValue (rv ^. #value))) entries)      formatOne :: (VarName, ResolvedVar) -> Text     formatOne (VarName n, rv) =-      let valText = showValue rv.value+      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+       in "  " <> n <> namePad <> " = " <> valText <> valPad <> "  " <> showSource (rv ^. #source)      showValue :: VarValue -> Text     showValue (VText t) = "\"" <> t <> "\""@@ -313,7 +314,7 @@     showSource (FromNamespaceConfig ns) = "[namespace: " <> ns <> "]"     showSource (FromContextConfig ctx) = "[context: " <> ctx <> "]"     showSource FromGlobalConfig = "[global config]"-    showSource (FromParent mn) = "[parent: " <> mn.unModuleName <> "]"+    showSource (FromParent mn) = "[parent: " <> mn ^. #unModuleName <> "]"     showSource FromDefault = "[default]"     showSource FromPrompt = "[prompt]"     showSource (FromCommand cmd) = "[command: " <> cmd <> "]"@@ -324,15 +325,15 @@ formatDeclarations decls =   T.unlines (map formatOne decls)   where-    maxNameLen = maximum (0 : map (\d -> T.length d.name.unVarName) decls)+    maxNameLen = maximum (0 : map (\d -> T.length (d ^. #name . #unVarName)) decls)      formatOne :: VarDecl -> Text     formatOne d =-      let VarName n = d.name+      let VarName n = (d ^. #name)           namePad = T.replicate (maxNameLen - T.length n) " "-          valText = case d.default_ of+          valText = case d ^. #default_ of             Nothing-              | d.required -> "(required, no default)"+              | d ^. #required -> "(required, no default)"               | otherwise -> "(optional, no default)"             Just v -> showDeclValue v        in "  " <> n <> namePad <> " = " <> valText@@ -362,15 +363,15 @@ diagnoseResolution resolved decls localConfig nsConfig ctxConfig globalConfig =   (unusedConfigKeys, unresolvedOptional)   where-    declaredNames = Set.fromList (map (.name) decls)+    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 ^. #name       | d <- decls,-        not d.required,-        not (Map.member d.name resolved)+        not (d ^. #required),+        not (Map.member (d ^. #name) resolved)       ]

@@ -6,7 +6,6 @@ where  import Data.Text qualified as T-import GHC.Generics (Generic) import Numeric.Natural (Natural) import Seihou.Prelude 

@@ -11,7 +11,7 @@     agentPromptDecoder,     commandVarDecoder,     promptGuidanceDecoder,-    agentPromptLaunchDecoder,+    agentLaunchDecoder,     blueprintFileDecoder,     registryDecoder,     registryEntryDecoder,@@ -35,6 +35,7 @@  import Control.Exception (SomeException, evaluate, throwIO, try) import Data.Either.Validation (Validation (..))+import Data.Generics.Labels () import Data.List (foldl') import Data.Map.Strict qualified as Map import Data.Text qualified as T@@ -96,10 +97,10 @@     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+        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@@ -125,8 +126,8 @@     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+        mapM_ (\v -> evaluate (v ^. #type_)) (r ^. #vars)+        mapM_ (\p -> evaluate (p ^. #condition)) (r ^. #prompts)         pure r       Failure e -> throwIO e   case result of@@ -276,9 +277,11 @@     )  -- | Decoder for the top-level Blueprint type from Dhall.+-- Uses 'withDefaults' to handle blueprints that predate the @migrations@ and+-- @launch@ fields. blueprintDecoder :: Decoder Blueprint blueprintDecoder =-  withDefaults [("migrations", emptyMigrationList)] $+  withDefaults [("migrations", emptyMigrationList), ("launch", noneText)] $     record       ( Blueprint           <$> field "name" moduleNameDecoder@@ -292,6 +295,7 @@           <*> field "allowedTools" (maybe (list strictText))           <*> field "tags" (list strictText)           <*> field "migrations" (list blueprintMigrationDecoder)+          <*> field "launch" (maybe agentLaunchDecoder)       )  -- | Evaluate a @blueprint.dhall@ file and decode it into a 'Blueprint'.@@ -311,8 +315,8 @@     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+        mapM_ (\v -> evaluate (v ^. #type_)) (b ^. #vars)+        mapM_ (\p -> evaluate (p ^. #condition)) (b ^. #prompts)         pure b       Failure e -> throwIO e   case result of@@ -344,15 +348,19 @@           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 the shared launch record declared by a 'Blueprint' or an+-- 'AgentPrompt'. @effort@ and @mode@ are defaulted so artifacts authored+-- against a schema pin that predates them still decode.+agentLaunchDecoder :: Decoder AgentLaunch+agentLaunchDecoder =+  withDefaults [("effort", noneText), ("mode", noneText)] $+    record+      ( AgentLaunch+          <$> field "provider" (maybe strictText)+          <*> field "model" (maybe strictText)+          <*> field "effort" (maybe strictText)+          <*> field "mode" (maybe strictText)+      )  -- | Decoder for a prompt guidance block. promptGuidanceDecoder :: Decoder PromptGuidance@@ -388,7 +396,7 @@           <*> field "files" (list blueprintFileDecoder)           <*> field "allowedTools" (maybe (list strictText))           <*> field "tags" (list strictText)-          <*> field "launch" (maybe agentPromptLaunchDecoder)+          <*> field "launch" (maybe agentLaunchDecoder)       )  emptyPromptGuidanceList :: Dhall.Expr Src Void@@ -405,10 +413,10 @@     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+        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@@ -491,7 +499,7 @@         )      mkDep :: ModuleName -> [(VarName, Text)] -> Dependency-    mkDep name bindings = Dependency {depModule = name, depVars = Map.fromList bindings}+    mkDep name bindings = Dependency {module_ = name, vars = Map.fromList bindings}  -- | Decoder for VarType from a Dhall Text string. -- Dhall does not support recursive types, so VarType is represented as a@@ -560,25 +568,25 @@ -- 'evalModuleFromFile' and surfaced as a 'DhallEvalError'. coerceDeclDefault :: VarDecl -> VarDecl coerceDeclDefault decl =-  case decl.default_ of+  case decl ^. #default_ of     Nothing -> decl     Just rawDefault ->-      case coerceDefault decl.name decl.type_ rawDefault of-        Right val -> decl {default_ = Just val}+      case coerceDefault (decl ^. #name) (decl ^. #type_) rawDefault of+        Right val -> decl & #default_ ?~ val         -- Caught by 'try' in 'evalModuleFromFile'-        Left err -> error (T.unpack (renderDefaultError decl.name err))+        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+    <> 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)+  "Invalid default for variable '" <> name ^. #unVarName <> "': " <> T.pack (show err)  -- | A short rendering of a declared variable type for error messages. renderVarType :: VarType -> Text

@@ -4,6 +4,7 @@ where  import Control.Monad (filterM, unless, when)+import Data.Generics.Labels () import Data.Maybe (mapMaybe) import Data.Set qualified as Set import Data.Text qualified as T@@ -33,7 +34,7 @@     finalExists <- doesFileExist finalPath     reusable <-       if finalExists-        then ((== ref.unBaselineRef) . hashContent) <$> readFileText finalPath+        then ((== ref ^. #unBaselineRef) . hashContent) <$> readFileText finalPath         else pure False     unless reusable $ do       writeFileText tempPath content@@ -50,7 +51,7 @@           else do             content <- readFileText path             let actual = hashContent content-            if actual == ref.unBaselineRef+            if actual == ref ^. #unBaselineRef               then pure (Right content)               else pure (Left (BaselineCorrupt ref actual))   PruneBaselines referenced -> do@@ -71,12 +72,12 @@           isFile <- doesFileExist path           if not isFile             then pure False-            else ((== ref.unBaselineRef) . hashContent) <$> readFileText path+            else ((== ref ^. #unBaselineRef) . hashContent) <$> readFileText path  baselinePath :: FilePath -> BaselineRef -> Maybe FilePath baselinePath root ref = do-  normalized <- baselineRefFromText ref.unBaselineRef.unSHA256-  pure (root </> T.unpack normalized.unBaselineRef.unSHA256)+  normalized <- baselineRefFromText (ref ^. #unBaselineRef . #unSHA256)+  pure (root </> T.unpack (normalized ^. #unBaselineRef . #unSHA256))  checkedBaselinePath :: FilePath -> BaselineRef -> FilePath checkedBaselinePath root ref = case baselinePath root ref of

@@ -3,6 +3,7 @@   ) where +import Data.Generics.Labels () import Data.Map.Strict (Map) import Data.Map.Strict qualified as Map import Data.Set qualified as Set@@ -32,7 +33,7 @@           Nothing -> Left (BaselineMissing ref)           Just content ->             let actual = hashContent content-             in if actual == ref.unBaselineRef+             in if actual == ref ^. #unBaselineRef                   then Right content                   else Left (BaselineCorrupt ref actual)       PruneBaselines referenced -> do@@ -40,7 +41,7 @@         let removable =               Map.keysSet $                 Map.filterWithKey-                  (\ref content -> Set.notMember ref referenced && hashContent content == ref.unBaselineRef)+                  (\ref content -> Set.notMember ref referenced && hashContent content == ref ^. #unBaselineRef)                   store         modify @(Map BaselineRef Text) (`Map.withoutKeys` removable)         pure (Set.toAscList removable)

@@ -5,6 +5,7 @@   ) where +import Data.Generics.Labels () import Data.Map.Strict qualified as Map import Effectful.State.Static.Local (State, get, modify, runState) import Seihou.Core.Types (ConfigScope (..))@@ -13,19 +14,19 @@  -- | 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+  { local :: !(Map Text Text),+    namespaces :: !(Map Text (Map Text Text)),+    global :: !(Map Text Text)   }-  deriving stock (Eq, Show)+  deriving stock (Eq, Generic, Show)  -- | Empty initial state with no config values in any scope. emptyConfigWriterState :: ConfigWriterState emptyConfigWriterState =   ConfigWriterState-    { cwLocal = Map.empty,-      cwNamespaces = Map.empty,-      cwGlobal = Map.empty+    { local = Map.empty,+      namespaces = Map.empty,+      global = Map.empty     }  -- | Pure interpreter for the ConfigWriter effect using in-memory state.@@ -46,22 +47,22 @@         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 ScopeLocal key val st = st & #local . at key ?~ val writeToScope (ScopeNamespace ns) key val st =-  let nsMap = Map.findWithDefault Map.empty ns st.cwNamespaces+  let nsMap = Map.findWithDefault Map.empty ns (st ^. #namespaces)       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}+   in st & #namespaces . at ns ?~ updated+writeToScope ScopeGlobal key val st = st & #global . at key ?~ val  deleteFromScope :: ConfigScope -> Text -> ConfigWriterState -> ConfigWriterState-deleteFromScope ScopeLocal key st = st {cwLocal = Map.delete key st.cwLocal}+deleteFromScope ScopeLocal key st = st & #local . at key .~ Nothing deleteFromScope (ScopeNamespace ns) key st =-  let nsMap = Map.findWithDefault Map.empty ns st.cwNamespaces+  let nsMap = Map.findWithDefault Map.empty ns (st ^. #namespaces)       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}+   in st & #namespaces . at ns ?~ updated+deleteFromScope ScopeGlobal key st = st & #global . at key .~ Nothing  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+readScope ScopeLocal st = st ^. #local+readScope (ScopeNamespace ns) st = Map.findWithDefault Map.empty ns (st ^. #namespaces)+readScope ScopeGlobal st = st ^. #global

@@ -6,6 +6,7 @@   ) where +import Data.Generics.Labels () import Effectful.State.Static.Local (State, get, modify, runState) import Seihou.Effect.Console (Console (..)) import Seihou.Prelude@@ -13,11 +14,11 @@  -- | State for the pure Console interpreter. data ConsoleState = ConsoleState-  { consoleInputs :: [Text],-    consoleOutputs :: [Text],-    consoleErrors :: [Text]+  { inputs :: ![Text],+    outputs :: ![Text],+    errors :: ![Text]   }-  deriving stock (Eq, Show)+  deriving stock (Eq, Generic, Show)  -- | Empty console state with no inputs or outputs. emptyConsoleState :: ConsoleState@@ -30,8 +31,8 @@   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]})+      PutText msg -> modify @ConsoleState (\s -> s & #outputs %~ (<> [msg]))+      PutError msg -> modify @ConsoleState (\s -> s & #errors %~ (<> [msg]))       GetLine -> popInput       Confirm _prompt -> (`elem` ["y", "yes"]) <$> popInput       IsInteractive -> pure True@@ -39,10 +40,10 @@     popInput :: (State ConsoleState :> es') => Eff es' Text     popInput = do       s <- get @ConsoleState-      case s.consoleInputs of+      case s ^. #inputs of         [] -> pure ""         (x : xs) -> do-          modify @ConsoleState (\st -> st {consoleInputs = xs})+          modify @ConsoleState (\st -> st & #inputs .~ xs)           pure x  -- | Pure interpreter for non-interactive mode. IsInteractive returns False.@@ -51,8 +52,8 @@   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]})+      PutText msg -> modify @ConsoleState (\s -> s & #outputs %~ (<> [msg]))+      PutError msg -> modify @ConsoleState (\s -> s & #errors %~ (<> [msg]))       GetLine -> pure ""       Confirm _prompt -> pure False       IsInteractive -> pure False

@@ -5,6 +5,7 @@   ) where +import Data.Generics.Labels () import Data.Map.Strict qualified as Map import Data.Set qualified as Set import Effectful.State.Static.Local (State, get, modify, put, runState)@@ -13,10 +14,10 @@  -- | In-memory filesystem state for testing. data PureFS = PureFS-  { files :: Map FilePath Text,-    dirs :: Set FilePath+  { files :: !(Map FilePath Text),+    dirs :: !(Set FilePath)   }-  deriving stock (Eq, Show)+  deriving stock (Eq, Generic, Show)  -- | An empty in-memory filesystem. emptyFS :: PureFS@@ -31,50 +32,50 @@     handler _ = \case       ReadFileText path -> do         fs <- get @PureFS-        case Map.lookup path fs.files of+        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})+        modify @PureFS (\fs -> fs & #files . at path ?~ content)       CopyFile src dest -> do         fs <- get @PureFS-        case Map.lookup src fs.files of+        case Map.lookup src (fs ^. #files) of           Just content ->-            put fs {files = Map.insert dest content fs.files}+            put (fs & #files . at dest ?~ content)           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,+              | fp <- Map.keys (fs ^. #files),                 isDirectChild prefix fp               ]             dirsInDir =               [ drop (length prefix) d-              | d <- Set.toList fs.dirs,+              | 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})+        modify @PureFS (\fs -> fs & #dirs %~ Set.insert path)       DoesFileExist path -> do         fs <- get @PureFS-        pure (Map.member path fs.files)+        pure (Map.member path (fs ^. #files))       DoesDirectoryExist path -> do         fs <- get @PureFS-        pure (Set.member path fs.dirs)+        pure (Set.member path (fs ^. #dirs))       GetCurrentDirectory -> pure "/pure-fs"       RemoveFile path -> do-        modify @PureFS (\fs -> fs {files = Map.delete path fs.files})+        modify @PureFS (\fs -> fs & #files . at path .~ Nothing)       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)+              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})+          else modify @PureFS (\fs' -> fs' & #dirs %~ Set.delete path)       RenamePath src dest -> do         modify @PureFS (renameInPureFS src dest)       RemoveDirectoryRecursive path -> do@@ -106,9 +107,13 @@ -- 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}+  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@@ -123,6 +128,7 @@       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-        }+        & #files+        %~ Map.filterWithKey (\k _ -> keepFile k)+        & #dirs+        %~ Set.filter keepDir

@@ -5,6 +5,7 @@   ) where +import Data.Generics.Labels () import Effectful.State.Static.Local (State, modify, runState) import Seihou.Effect.Logger (Logger (..)) import Seihou.Prelude@@ -12,12 +13,12 @@ -- | 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]+  { debugMsgs :: ![Text],+    infoMsgs :: ![Text],+    warnMsgs :: ![Text],+    errorMsgs :: ![Text]   }-  deriving stock (Eq, Show)+  deriving stock (Eq, Generic, Show)  -- | Empty logger state with no captured messages. emptyLoggerState :: LoggerState@@ -31,7 +32,7 @@   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]})+      LogDebug msg -> modify @LoggerState (\s -> s & #debugMsgs %~ (<> [msg]))+      LogInfo msg -> modify @LoggerState (\s -> s & #infoMsgs %~ (<> [msg]))+      LogWarn msg -> modify @LoggerState (\s -> s & #warnMsgs %~ (<> [msg]))+      LogError msg -> modify @LoggerState (\s -> s & #errorMsgs %~ (<> [msg]))

@@ -12,6 +12,8 @@ runProcessIO :: (IOE :> es) => Eff (Process : es) a -> Eff es a runProcessIO = interpret $ \_ -> \case   RunProcess cmd args workDir -> liftIO $ do+    -- CreateProcess is a third-party type with no Generic instance, so it has+    -- no #cwd label to set. Record update syntax is the only option here.     let cp =           (proc (T.unpack cmd) (map T.unpack args))             { cwd = workDir

@@ -4,16 +4,17 @@   ) where +import Data.Generics.Labels () import Seihou.Effect.Process (Process (..)) import Seihou.Prelude import System.Exit (ExitCode (..))  data ProcessMock = ProcessMock-  { mockCommand :: Text,-    mockArgs :: [Text],-    mockResult :: (ExitCode, Text, Text)+  { command :: !Text,+    args :: ![Text],+    result :: !(ExitCode, Text, Text)   }-  deriving stock (Eq, Show)+  deriving stock (Eq, Generic, Show)  runProcessPure :: [ProcessMock] -> Eff (Process : es) a -> Eff es a runProcessPure mocks = interpret $ \_ -> \case@@ -25,5 +26,5 @@ findMock :: Text -> [Text] -> [ProcessMock] -> Maybe (ExitCode, Text, Text) findMock _ _ [] = Nothing findMock cmd args (m : ms)-  | m.mockCommand == cmd && m.mockArgs == args = Just m.mockResult+  | m ^. #command == cmd && m ^. #args == args = Just (m ^. #result)   | otherwise = findMock cmd args ms

@@ -5,6 +5,7 @@ where  import Control.Monad (foldM)+import Data.Generics.Labels () import Data.Map.Strict qualified as Map import Data.Maybe (mapMaybe) import Data.Set qualified as Set@@ -41,14 +42,16 @@           content <- readFileText fullPath           ref <- putBaseline content           let enriched =-                record-                  { hash = hashContent content,-                    baseline = Just ref-                  }+                ( record+                    & #hash+                    .~ hashContent content+                    & #baseline+                    ?~ ref+                )           pure (Right (Map.insert path enriched captured))  -- | Every blob protected by the currently durable manifest. Callers pass this -- set to 'pruneBaselines' only after publishing that manifest. manifestBaselineRefs :: Manifest -> Set BaselineRef manifestBaselineRefs manifest =-  Set.fromList (mapMaybe (.baseline) (Map.elems manifest.files))+  Set.fromList (mapMaybe (^. #baseline) (Map.elems (manifest ^. #files)))

@@ -4,6 +4,7 @@   ) where +import Data.Generics.Labels () import Data.Text qualified as T import Seihou.Core.Types (ConflictFile (..), ConflictResolution (..)) import Seihou.Effect.Console (Console, getLine, isInteractive, putText)@@ -61,7 +62,7 @@   ConflictFile ->   Eff es ConflictResolution promptConflict c = do-  putText $ "Conflict: " <> T.pack c.path <> " (modified since last generation)"+  putText $ "Conflict: " <> T.pack (c ^. #path) <> " (modified since last generation)"   promptChoice   where     promptChoice = do

@@ -4,6 +4,7 @@   ) where +import Data.Generics.Labels () import Data.Map.Strict qualified as Map import Data.Set (Set) import Data.Set qualified as Set@@ -38,9 +39,9 @@   [(FilePath, Text, ModuleName, Maybe PatchOp)] ->   Eff es DiffResult computeDiff manifest activeModules planned = do-  let manifestFiles' = manifest.files+  let manifestFiles' = (manifest ^. #files)       activeManifestFiles =-        Map.filter (\r -> r.moduleName `Set.member` activeModules) manifestFiles'+        Map.filter (\r -> (r ^. #moduleName) `Set.member` activeModules) manifestFiles'       planMap = Map.fromList [(p, (content, modName, patchOp)) | (p, content, modName, patchOp) <- planned]       allPaths =         Set.toList $@@ -112,7 +113,7 @@     (Just record, Just (content, modName, _), True) -> do       diskContent <- readFileText path       let diskHash = hashContent diskContent-          manifestHash = record.hash+          manifestHash = (record ^. #hash)           planHash = hashContent content       if diskHash /= manifestHash         then@@ -159,16 +160,16 @@           ( ModifiedFile               { path = path,                 moduleName = modName,-                oldHash = record.hash,+                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})+      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})+      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

@@ -4,6 +4,7 @@   ) where +import Data.Generics.Labels () import Data.Map.Strict qualified as Map import Data.Text qualified as T import Data.Time (UTCTime)@@ -113,7 +114,7 @@     formatOp (CopyFileOp src dest) = "  copy  " <> T.pack src <> " -> " <> T.pack dest     formatOp RunCommandOp {command = cmd} = "  run   " <> cmd     formatOp (PatchFileOp dest _ patchOp' _ modName) =-      "  patch " <> T.pack dest <> " (" <> formatPatchOp patchOp' <> " from " <> modName.unModuleName <> ")"+      "  patch " <> T.pack dest <> " (" <> formatPatchOp patchOp' <> " from " <> modName ^. #unModuleName <> ")"     formatPatchOp AppendFile = "append-file"     formatPatchOp PrependFile = "prepend-file"     formatPatchOp AppendSection = "append-section"

@@ -11,12 +11,12 @@   ) where +import Data.Generics.Labels () 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 (..),@@ -78,9 +78,9 @@ -- '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]+  { module_ :: !ModuleName,+    source :: !MigrationPlan,+    ops :: ![MigrationOpInstance]   }   deriving stock (Eq, Show, Generic) @@ -107,14 +107,14 @@   MigrationPlan ->   Eff es (Either MigrationExecError ExecutedMigrationPlan) classifyMigration manifest plan = do-  opsResult <- traverse (classifyOp manifest) (concatMap (.ops) plan.planSteps)+  opsResult <- traverse (classifyOp manifest) (concatMap (^. #ops) (plan ^. #steps))   pure $ do     ops <- sequence opsResult     Right       ExecutedMigrationPlan-        { planModule = ModuleName plan.planModule,-          planSource = plan,-          planOps = ops+        { module_ = ModuleName (plan ^. #module_),+          source = plan,+          ops = ops         }  -- | Classify a single 'MigrationOp' against the manifest and disk.@@ -173,12 +173,12 @@   exists <- doesFileExist path   if not exists     then pure MFGone-    else case Map.lookup path (manifest.files :: Map FilePath FileRecord) of+    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+        if diskHash == rec ^. #hash           then pure MFSafe           else pure MFConflict @@ -191,9 +191,9 @@ -- 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+-- @to@ (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.+-- advances to @to@ — this is the "pure version bump" path. executeMigration ::   (Filesystem :> es, Process :> es) =>   -- | If 'True', proceed even when files are 'MFConflict'. Mirrors the@@ -207,22 +207,24 @@ executeMigration force plan manifest now = do   let conflicts =         [ p-        | inst <- plan.planOps,+        | inst <- plan ^. #ops,           (p, MFConflict) <- toFileStatus inst         ]   if not force && not (null conflicts)     then pure (Left (MigrationConflict conflicts))     else do-      result <- runOps plan.planOps manifest []+      result <- runOps (plan ^. #ops) 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-                  }+                ( man'+                    & #genAt+                    .~ now+                    & #modules+                    %~ map (bumpVersion (plan ^. #module_) (plan ^. #source))+                )           pure (Right bumped)  -- | Pull (path, status) pairs out of an op for conflict detection. Only@@ -290,12 +292,12 @@ -- 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+  case Map.lookup src (manifest ^. #files) of     Nothing -> manifest     Just rec ->       manifest-        { files = Map.insert dest rec (Map.delete src manifest.files)-        }+        & #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@.@@ -306,26 +308,26 @@         | k == src = dest         | prefix `isPrefixOfPath` k = dest <> "/" <> drop (length prefix) k         | otherwise = k-   in manifest {files = Map.mapKeys rewriteKey manifest.files}+   in manifest & #files %~ Map.mapKeys rewriteKey  -- | Drop a single file entry from the manifest. dropFromManifest :: FilePath -> Manifest -> Manifest dropFromManifest p manifest =-  manifest {files = Map.delete p manifest.files}+  manifest & #files . at p .~ Nothing  -- | 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}+   in manifest & #files %~ Map.filterWithKey (\k _ -> keep k)  -- | 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)}+  | am ^. #name == modName =+      am & #moduleVersion ?~ (renderVersion (plan ^. #to))   | otherwise = am  -- ----------------------------------------------------------------------------

@@ -7,6 +7,7 @@ import Control.Exception (IOException, SomeException, catch, try) import Data.Aeson qualified as Aeson import Data.Aeson.Encode.Pretty qualified as AesonPretty+import Data.Generics.Labels () import Data.Map.Strict qualified as Map import Data.Set qualified as Set import Data.Text qualified as T@@ -36,11 +37,11 @@   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 modName = (modul ^. #name)+  results <- mapM (compileStep baseDir modName vars) (modul ^. #steps)   let (allErrors, allOps) = partitionResults results   if null allErrors-    then case compileCommands modName vars modul.commands of+    then case compileCommands modName vars (modul ^. #commands) of       Left cmdErrs -> pure (Left cmdErrs)       Right cmdOps -> pure (Right (deduplicateDirs (concat allOps) ++ cmdOps))     else pure (Left (concat allErrors))@@ -71,17 +72,17 @@                     }              in (Map.insert key (occurrence + 1) counts, ops ++ [operation], errs) -    shouldRun cmd = case cmd.condition of+    shouldRun cmd = case cmd ^. #condition of       Nothing -> True       Just expr -> evalExpr vars expr  -- | Compile a single command, interpolating placeholders in @run@ and @workDir@. compileOneCommand :: Map VarName VarValue -> Command -> Either [Text] (Text, Maybe FilePath) compileOneCommand vars cmd =-  case renderCommand cmd.run vars of+  case renderCommand (cmd ^. #run) vars of     Left placeholderErrors -> Left (map formatPlaceholderError placeholderErrors)     Right runText ->-      case cmd.workDir of+      case cmd ^. #workDir of         Nothing -> Right (runText, Nothing)         Just wd ->           case renderCommand wd vars of@@ -102,14 +103,14 @@   IO (Either [Text] [Operation]) compileStep baseDir modName vars step = do   -- Evaluate the when condition-  let shouldRun = case step.condition of+  let shouldRun = case step ^. #condition of         Nothing -> True         Just expr -> evalExpr vars expr   if not shouldRun     then pure (Right [])-    else case step.patch of+    else case step ^. #patch of       Just _ -> compilePatchStep baseDir vars modName step-      Nothing -> case step.strategy of+      Nothing -> case step ^. #strategy of         Copy -> compileCopyStep baseDir vars step         Template -> compileTemplateStep baseDir vars step         DhallText -> compileDhallTextStep baseDir vars step@@ -122,12 +123,12 @@   Step ->   IO (Either [Text] [Operation]) compileCopyStep baseDir vars step = do-  let srcPath = baseDir </> "files" </> step.src+  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+      case renderDestPath (step ^. #dest) vars of         Left placeholderErrors ->           pure (Left (map formatPlaceholderError placeholderErrors))         Right dest ->@@ -140,7 +141,7 @@   Step ->   IO (Either [Text] [Operation]) compileTemplateStep baseDir vars step = do-  let srcPath = baseDir </> "files" </> step.src+  let srcPath = baseDir </> "files" </> (step ^. #src)   result <- tryReadFile srcPath   case result of     Left err -> pure (Left [err])@@ -149,7 +150,7 @@         Left placeholderErrors ->           pure (Left (map formatPlaceholderError placeholderErrors))         Right rendered ->-          case renderDestPath step.dest vars of+          case renderDestPath (step ^. #dest) vars of             Left placeholderErrors ->               pure (Left (map formatPlaceholderError placeholderErrors))             Right dest ->@@ -162,7 +163,7 @@   Step ->   IO (Either [Text] [Operation]) compileDhallTextStep baseDir vars step = do-  let srcPath = baseDir </> "files" </> step.src+  let srcPath = baseDir </> "files" </> (step ^. #src)   result <- tryReadFile srcPath   case result of     Left err -> pure (Left [err])@@ -175,7 +176,7 @@           case dhallResult of             Left err -> pure (Left [err])             Right evaluated ->-              case renderDestPath step.dest vars of+              case renderDestPath (step ^. #dest) vars of                 Left placeholderErrors ->                   pure (Left (map formatPlaceholderError placeholderErrors))                 Right dest ->@@ -189,7 +190,7 @@   Step ->   IO (Either [Text] [Operation]) compileStructuredStep baseDir vars step = do-  let srcPath = baseDir </> "files" </> step.src+  let srcPath = baseDir </> "files" </> (step ^. #src)   result <- tryReadFile srcPath   case result of     Left err -> pure (Left [err])@@ -205,7 +206,7 @@               case dhallExprToJSON dhallExpr of                 Left err -> pure (Left [err])                 Right jsonValue ->-                  case renderDestPath step.dest vars of+                  case renderDestPath (step ^. #dest) vars of                     Left placeholderErrors ->                       pure (Left (map formatPlaceholderError placeholderErrors))                     Right dest ->@@ -226,8 +227,8 @@   Step ->   IO (Either [Text] [Operation]) compilePatchStep baseDir vars modName step = do-  let srcPath = baseDir </> "files" </> step.src-      patchOp' = case step.patch of+  let srcPath = baseDir </> "files" </> (step ^. #src)+      patchOp' = case step ^. #patch of         Just p -> p         Nothing -> error "compilePatchStep called without patch op"   result <- tryReadFile srcPath@@ -235,7 +236,7 @@     Left err -> pure (Left [err])     Right rawContent -> do       -- Render content based on strategy-      contentResult <- case step.strategy of+      contentResult <- case step ^. #strategy of         Copy -> pure (Right rawContent)         Template ->           pure $ case renderTemplateText rawContent vars of@@ -254,11 +255,11 @@       case contentResult of         Left errs -> pure (Left errs)         Right content ->-          case renderDestPath step.dest vars of+          case renderDestPath (step ^. #dest) vars of             Left placeholderErrors ->               pure (Left (map formatPlaceholderError placeholderErrors))             Right dest ->-              pure (patchFileOps dest content patchOp' step.strategy modName)+              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))

@@ -7,6 +7,7 @@   ) where +import Data.Generics.Labels () import Data.Map.Strict qualified as Map import Data.Set qualified as Set import Data.Text qualified as T@@ -26,15 +27,15 @@ -- | One line in the dry-run preview. data PreviewLine   = FilePreview-      { previewStatus :: FileStatus,-        previewPath :: FilePath,-        previewAnnotation :: Text,-        previewModule :: Maybe ModuleName+      { status :: !FileStatus,+        path :: !FilePath,+        annotation :: !Text,+        module_ :: !(Maybe ModuleName)       }   | DirPreview FilePath   | CommandPreview Text (Maybe ModuleName)   | OrphanPreview FilePath ModuleName-  deriving stock (Eq, Show)+  deriving stock (Eq, Generic, Show)  -- | Build a structured preview from operations and an optional diff result. -- The ownership map tracks which module produced each file path.@@ -56,9 +57,9 @@         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 [ OrphanPreview (o ^. #path) (o ^. #moduleName)+              | o <- diff ^. #orphaned,+                not (Set.member (o ^. #path) producedPaths)               ]    in opLines ++ orphanLines @@ -66,18 +67,18 @@ opToPreview :: Maybe DiffResult -> Map FilePath ModuleName -> Set Text -> Operation -> PreviewLine opToPreview mDiff ownerMap _ (WriteFileOp dest _ strat) =   FilePreview-    { previewStatus = lookupStatus dest mDiff,-      previewPath = dest,-      previewAnnotation = strategyName strat,-      previewModule = Map.lookup dest ownerMap+    { status = lookupStatus dest mDiff,+      path = dest,+      annotation = strategyName strat,+      module_ = 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+    { status = lookupStatus dest mDiff,+      path = dest,+      annotation = "copy",+      module_ = Map.lookup dest ownerMap     } opToPreview _ _ commandsNeedingOwner RunCommandOp {command, moduleName} =   CommandPreview@@ -85,21 +86,21 @@     (if Set.member command commandsNeedingOwner then Just moduleName else Nothing) opToPreview mDiff ownerMap _ (PatchFileOp dest _ _patchOp' _ modName') =   FilePreview-    { previewStatus = lookupStatus dest mDiff,-      previewPath = dest,-      previewAnnotation = "patch",-      previewModule = Just modName'+    { status = lookupStatus dest mDiff,+      path = dest,+      annotation = "patch",+      module_ = 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+  | 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).@@ -111,14 +112,17 @@   where     fileLines = [l | l@(FilePreview {}) <- lines']     nonFileLines = [l | l <- lines', not (isFileLine l)]-    maxPathLen = maximum (0 : map (T.length . T.pack . (.previewPath)) fileLines)+    -- PreviewLine is a sum type and `path` lives only in FilePreview, so this+    -- is a pattern match rather than a #path read: generic-lens can only build+    -- a lens for a field that every constructor has.+    maxPathLen = maximum (0 : [T.length (T.pack p) | FilePreview {path = p} <- lines'])  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+        Just mn -> ", " <> (mn ^. #unModuleName)         Nothing -> ""    in "    " <> statusTag status <> "  " <> pathText <> pathPad <> "  (" <> annotation <> modSuffix <> ")" renderPlainLine _ other = renderNonFileLine other@@ -129,9 +133,9 @@ renderNonFileLine (CommandPreview cmd mOwner) =   "    run    " <> cmd <> ownerSuffix mOwner   where-    ownerSuffix = maybe "" (\owner -> "  (" <> owner.unModuleName <> ")")+    ownerSuffix = maybe "" (\owner -> "  (" <> owner ^. #unModuleName <> ")") renderNonFileLine (OrphanPreview path modName') =-  "    [orphaned]  " <> T.pack path <> "  (orphaned from " <> modName'.unModuleName <> ")"+  "    [orphaned]  " <> T.pack path <> "  (orphaned from " <> modName' ^. #unModuleName <> ")" renderNonFileLine _ = ""  isFileLine :: PreviewLine -> Bool@@ -165,7 +169,7 @@   where     header =       "Generation Plan ("-        <> T.intercalate " + " (map (.unModuleName) moduleNames)+        <> T.intercalate " + " (map (^. #unModuleName) moduleNames)         <> "):"      varsSection =@@ -188,8 +192,8 @@     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+    nFiles = length (diff ^. #new) + length (diff ^. #modified)+    nConflicts = length (diff ^. #conflicts)     summaryText =       "  "         <> T.pack (show nFiles)

@@ -23,6 +23,7 @@  import Control.Monad (foldM) import Data.Foldable (traverse_)+import Data.Generics.Labels () import Data.List (foldl') import Data.Map.Strict qualified as Map import Data.Set qualified as Set@@ -41,20 +42,20 @@ -- The application set is path-specific: a batch may update several -- applications without every application contributing to every path. data DesiredFileOwner = DesiredFileOwner-  { moduleName :: ModuleName,-    applicationIds :: Set ApplicationId+  { moduleName :: !ModuleName,+    applicationIds :: !(Set ApplicationId)   }-  deriving stock (Eq, Show)+  deriving stock (Eq, Generic, Show)  -- | The final generated side after all operations for a path are replayed. data DesiredFile = DesiredFile-  { path :: FilePath,-    generatedContent :: Text,-    moduleName :: ModuleName,-    strategy :: Strategy,-    applicationIds :: Set ApplicationId+  { path :: !FilePath,+    generatedContent :: !Text,+    moduleName :: !ModuleName,+    strategy :: !Strategy,+    applicationIds :: !(Set ApplicationId)   }-  deriving stock (Eq, Show)+  deriving stock (Eq, Generic, Show)  data ReconciliationReason   = MissingTrustedBaseline@@ -66,28 +67,28 @@ -- | The disk snapshot used while planning. Applying verifies every snapshot -- before the first mutation, so a resolution cannot overwrite later edits. data ObservedFile = ObservedFile-  { existed :: Bool,-    contentHash :: Maybe SHA256+  { existed :: !Bool,+    contentHash :: !(Maybe SHA256)   }-  deriving stock (Eq, Show)+  deriving stock (Eq, Generic, Show)  -- | The exact generated ancestor and applied bytes a resolved action will -- publish. @writeToDisk@ is false for paths already containing those bytes. -- @recordedHash@ may intentionally remain the prior applied hash for a -- user-only edit that generation did not change. data PlannedFileState = PlannedFileState-  { generatedBaseline :: Text,-    appliedContent :: Text,-    recordedHash :: SHA256,-    writeToDisk :: Bool+  { generatedBaseline :: !Text,+    appliedContent :: !Text,+    recordedHash :: !SHA256,+    writeToDisk :: !Bool   }-  deriving stock (Eq, Show)+  deriving stock (Eq, Generic, Show)  data ResolvedFileConflict = ResolvedFileConflict-  { choice :: FileConflictChoice,-    state :: PlannedFileState+  { choice :: !FileConflictChoice,+    state :: !PlannedFileState   }-  deriving stock (Eq, Show)+  deriving stock (Eq, Generic, Show)  data FileReconciliation   = FileCreate DesiredFile PlannedFileState ObservedFile@@ -109,11 +110,11 @@   deriving stock (Eq, Show)  data ReconciliationPlan = ReconciliationPlan-  { applicationIds :: Set ApplicationId,-    files :: Map FilePath FileReconciliation,-    requiredDirectories :: Set FilePath+  { applicationIds :: !(Set ApplicationId),+    files :: !(Map FilePath FileReconciliation),+    requiredDirectories :: !(Set FilePath)   }-  deriving stock (Eq, Show)+  deriving stock (Eq, Generic, Show)  data ReconciliationError   = InvalidReconciliationPath FilePath Text@@ -143,16 +144,16 @@   deriving stock (Eq, Show)  data ReconciliationSummary = ReconciliationSummary-  { creates :: Int,-    updates :: Int,-    merged :: Int,-    unchanged :: Int,-    conflicts :: Int,-    safeDeletes :: Int,-    editedOrphans :: Int,-    sharedOwnership :: Int+  { creates :: !Int,+    updates :: !Int,+    merged :: !Int,+    unchanged :: !Int,+    conflicts :: !Int,+    safeDeletes :: !Int,+    editedOrphans :: !Int,+    sharedOwnership :: !Int   }-  deriving stock (Eq, Show)+  deriving stock (Eq, Generic, Show)  -- | Production planner using the repository filesystem and baseline effects, -- with EP-65's Git-backed merge driver for dual edits.@@ -231,13 +232,14 @@                 }  data DesiredContext = DesiredContext-  { desired :: DesiredFile,-    current :: Maybe Text,-    baseline :: Maybe Text,-    priorRecord :: Maybe FileRecord,-    observed :: ObservedFile,-    missingTrustedBaseline :: Bool+  { desired :: !DesiredFile,+    current :: !(Maybe Text),+    baseline :: !(Maybe Text),+    priorRecord :: !(Maybe FileRecord),+    observed :: !ObservedFile,+    missingTrustedBaseline :: !Bool   }+  deriving stock (Generic)  validateInputs ::   Set ApplicationId ->@@ -262,15 +264,15 @@ validateOwner selected ownerMap manifest path = case Map.lookup path ownerMap of   Nothing -> Left (MissingDesiredOwner path)   Just owner-    | not (owner.applicationIds `Set.isSubsetOf` selected) ->-        Left (DesiredOwnerOutsideSelection path (owner.applicationIds Set.\\ selected))-    | otherwise -> case Map.lookup path manifest.files of+    | not ((owner ^. #applicationIds) `Set.isSubsetOf` selected) ->+        Left (DesiredOwnerOutsideSelection path ((owner ^. #applicationIds) Set.\\ selected))+    | otherwise -> case Map.lookup path (manifest ^. #files) of         Nothing -> Right ()         Just record ->-          let unselectedOwners = record.applicationIds Set.\\ selected+          let unselectedOwners = (record ^. #applicationIds) Set.\\ selected            in if Set.null unselectedOwners                 then Right ()-                else Left (SharedPathRequiresApplications path record.applicationIds)+                else Left (SharedPathRequiresApplications path (record ^. #applicationIds))  validateManagedPath :: FilePath -> Either ReconciliationError () validateManagedPath rawPath = case validateProjectRelativePath (T.pack rawPath) of@@ -316,7 +318,7 @@   m (Either ReconciliationError DesiredContext) materializeOne readDisk readCopy readStoredBaseline ownerMap manifest pathOperations = do   let path = operationPath pathOperations-      prior = Map.lookup path manifest.files+      prior = Map.lookup path (manifest ^. #files)       owner = ownerMap Map.! path       containsReplacement = any isReplacement pathOperations   current <- readDisk path@@ -351,9 +353,9 @@           DesiredFile             { path = path,               generatedContent = generated,-              moduleName = owner.moduleName,+              moduleName = owner ^. #moduleName,               strategy = finalStrategy,-              applicationIds = owner.applicationIds+              applicationIds = owner ^. #applicationIds             }     Right       DesiredContext@@ -378,13 +380,13 @@   FileRecord ->   Maybe Text ->   m BaselineTrust-trustedBaseline readStored record current = case record.baseline of+trustedBaseline readStored record current = case record ^. #baseline of   Just ref -> do     result <- readStored ref     pure (either (const Untrusted) (\content -> Trusted content False) result)   Nothing ->     pure $ case current of-      Just content | hashContent content == record.hash -> Trusted content True+      Just content | hashContent content == record ^. #hash -> Trusted content True       _ -> Untrusted  applyGenerationOperation ::@@ -419,20 +421,20 @@   (Text -> Text -> Text -> m MergeOutcome) ->   DesiredContext ->   m (Either ReconciliationError (FilePath, FileReconciliation))-classifyDesired mergeContents context = case context.current of+classifyDesired mergeContents context = case context ^. #current of   Nothing -> pure $ Right (path, classifyMissing)   Just current-    | context.missingTrustedBaseline ->+    | context ^. #missingTrustedBaseline ->         pure $ Right (path, unresolved current current MissingTrustedBaseline)-    | otherwise -> case context.baseline of+    | otherwise -> case context ^. #baseline of         Nothing -> pure $ Right (path, unresolved current current MissingTrustedBaseline)         Just baseline -> classifyPresent baseline current   where-    desired = context.desired-    path = desired.path-    generated = desired.generatedContent-    prior = context.priorRecord-    observed = context.observed+    desired = (context ^. #desired)+    path = (desired ^. #path)+    generated = (desired ^. #generatedContent)+    prior = (context ^. #priorRecord)+    observed = (context ^. #observed)      classifyMissing = case prior of       Nothing -> FileCreate desired (automaticState generated True) observed@@ -444,7 +446,7 @@       | current == baseline =           pure (Right (path, FileUpdate desired (automaticState generated True) observed prior))       | generated == baseline =-          let priorHash = maybe (hashContent current) (.hash) prior+          let priorHash = maybe (hashContent current) (^. #hash) prior               state = PlannedFileState generated current priorHash False            in pure (Right (path, FileUnchanged desired state observed prior))       | current == generated =@@ -456,7 +458,7 @@     fromMerge _ (MergeClean merged) =       FileAutoMerge         desired-        (PlannedFileState generated merged (hashContent merged) (context.current /= Just merged))+        (PlannedFileState generated merged (hashContent merged) (context ^. #current /= Just merged))         observed         prior     fromMerge current (MergeConflicted markers) = unresolved current markers OverlappingEdits@@ -482,20 +484,20 @@   where     candidates =       [ (path, record)-      | (path, record) <- Map.toList manifest.files,-        Set.null (Set.intersection selected record.applicationIds) == False,+      | (path, record) <- Map.toList (manifest ^. #files),+        Set.null (Set.intersection selected (record ^. #applicationIds)) == False,         Set.notMember path desiredPaths       ]     classify (path, record) = do       current <- readDisk path       let observed = observe current-          remainingOwners = record.applicationIds Set.\\ selected+          remainingOwners = (record ^. #applicationIds) Set.\\ selected           action             | not (Set.null remainingOwners) = FileReleaseSharedOwnership path record observed             | otherwise = case current of                 Nothing -> FileAlreadyAbsent path record observed                 Just content-                  | hashContent content == record.hash -> FileDeleteSafe path record observed+                  | hashContent content == record ^. #hash -> FileDeleteSafe path record observed                   | otherwise -> FileOrphanEdited path record content observed Nothing       pure (path, action) @@ -507,24 +509,24 @@   FileConflictChoice ->   ReconciliationPlan ->   Either ReconciliationError ReconciliationPlan-resolveFileConflict path choice plan = case Map.lookup path plan.files of+resolveFileConflict path choice plan = case Map.lookup path (plan ^. #files) of   Nothing -> Left (ReconciliationPathNotFound path)   Just (FileConflict _ _ _ _ _ _ _) | choice == AbortUpdate -> Left (UpdateAborted path)   Just (FileConflict desired current markers reason observed prior _) ->     let applied = case choice of-          AcceptGenerated -> desired.generatedContent+          AcceptGenerated -> (desired ^. #generatedContent)           KeepCurrent -> current           WriteConflictMarkers -> markers           AbortUpdate -> current         state =           PlannedFileState-            { generatedBaseline = desired.generatedContent,+            { generatedBaseline = desired ^. #generatedContent,               appliedContent = applied,               recordedHash = hashContent applied,-              writeToDisk = applied /= current || not observed.existed+              writeToDisk = applied /= current || not (observed ^. #existed)             }         resolved = FileConflict desired current markers reason observed prior (Just (ResolvedFileConflict choice state))-     in Right (replacePlanFiles plan (Map.insert path resolved plan.files))+     in Right (replacePlanFiles plan (Map.insert path resolved (plan ^. #files)))   Just _ -> Left (NotAFileConflict path)  resolveEditedOrphan ::@@ -532,7 +534,7 @@   OrphanChoice ->   ReconciliationPlan ->   Either ReconciliationError ReconciliationPlan-resolveEditedOrphan path choice plan = case Map.lookup path plan.files of+resolveEditedOrphan path choice plan = case Map.lookup path (plan ^. #files) of   Nothing -> Left (ReconciliationPathNotFound path)   Just (FileOrphanEdited _ _ _ _ _) | choice == AbortOrphanUpdate -> Left (UpdateAborted path)   Just (FileOrphanEdited orphanPath record content observed _) ->@@ -542,12 +544,12 @@         ( Map.insert             path             (FileOrphanEdited orphanPath record content observed (Just choice))-            plan.files+            (plan ^. #files)         )   Just _ -> Left (NotAnEditedOrphan path)  reconciliationSummary :: ReconciliationPlan -> ReconciliationSummary-reconciliationSummary = foldl' count emptySummary . Map.elems . (.files)+reconciliationSummary = foldl' count emptySummary . Map.elems . (^. #files)   where     emptySummary = ReconciliationSummary 0 0 0 0 0 0 0 0     count summary reconciliation = case reconciliation of@@ -556,7 +558,7 @@       FileAutoMerge _ _ _ _ -> addMerge summary       FileUnchanged _ _ _ _ -> addUnchanged summary       FileConflict _ _ _ _ _ _ Nothing -> addConflict summary-      FileConflict _ _ _ _ _ _ (Just resolved) -> case resolved.choice of+      FileConflict _ _ _ _ _ _ (Just resolved) -> case resolved ^. #choice of         AcceptGenerated -> addUpdate summary         KeepCurrent -> addMerge summary         WriteConflictMarkers -> addMerge summary@@ -578,16 +580,16 @@ replacePlanFiles :: ReconciliationPlan -> Map FilePath FileReconciliation -> ReconciliationPlan replacePlanFiles plan newFiles =   ReconciliationPlan-    { applicationIds = plan.applicationIds,+    { applicationIds = plan ^. #applicationIds,       files = newFiles,-      requiredDirectories = plan.requiredDirectories+      requiredDirectories = plan ^. #requiredDirectories     }  reconciliationMutationPaths :: ReconciliationPlan -> Set FilePath-reconciliationMutationPaths = Map.keysSet . (.files)+reconciliationMutationPaths = Map.keysSet . (^. #files)  unresolvedPaths :: ReconciliationPlan -> Set FilePath-unresolvedPaths plan = Map.keysSet (Map.filter unresolved plan.files)+unresolvedPaths plan = Map.keysSet (Map.filter unresolved (plan ^. #files))   where     unresolved (FileConflict _ _ _ _ _ _ Nothing) = True     unresolved (FileOrphanEdited _ _ _ _ Nothing) = True

@@ -13,6 +13,7 @@ where  import Control.Monad (foldM)+import Data.Generics.Labels () import Data.List (nub, sortBy) import Data.Map.Strict qualified as Map import Data.Ord (Down (..))@@ -44,10 +45,10 @@  -- | A plan describing what files to remove for a given module. data RemovalPlan = RemovalPlan-  { targetModule :: ModuleName,-    files :: [RemovalFile]+  { targetModule :: !ModuleName,+    files :: ![RemovalFile]   }-  deriving stock (Eq, Show)+  deriving stock (Eq, Generic, Show)  -- ============================================================ -- New step-based removal types@@ -77,10 +78,10 @@  -- | A removal plan built from declared removal steps. data ExecutedRemovalPlan = ExecutedRemovalPlan-  { targetModule :: ModuleName,-    ops :: [RemovalOp]+  { targetModule :: !ModuleName,+    ops :: ![RemovalOp]   }-  deriving stock (Eq, Show)+  deriving stock (Eq, Generic, Show)  -- | Errors that prevent removal. data RemovalError@@ -108,7 +109,7 @@   case findApplied manifest modName of     Nothing -> pure (Left (ModuleNotApplied modName))     Just am-      | Nothing <- am.removal -> pure (Left (ModuleNotRemovable modName))+      | Nothing <- am ^. #removal -> pure (Left (ModuleNotRemovable modName))       | otherwise -> do           let ownedFiles = moduleFiles manifest modName           classified <- mapM classifyForRemoval ownedFiles@@ -127,7 +128,7 @@   let toDelete = filesToDelete plan keepSet   mapM_ removeFile toDelete   cleanupEmptyDirs toDelete-  pure (removeFromManifest manifest plan.targetModule now)+  pure (removeFromManifest manifest (plan ^. #targetModule) now)  -- ============================================================ -- New step-based removal engine@@ -145,8 +146,8 @@   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+      stepResults <- mapM (buildStepOp manifest modName) (removal ^. #steps)+      let cmdResults = map buildCommandOp (removal ^. #commands)       pure $ do         stepOps <- sequence stepResults         cmdOps <- sequence cmdResults@@ -163,31 +164,31 @@   ModuleName ->   RemovalStep ->   Eff es (Either RemovalError RemovalOp)-buildStepOp manifest _modName step = case step.action of+buildStepOp manifest _modName step = case step ^. #action of   RemoveFileAction ->-    case validateRemovalPath "remove-file destination" step.dest of+    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+      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+      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+  case traverse (validateRemovalPath "remove-command workDir") (command ^. #workDir) of     Left err -> Left err-    Right safeWorkDir -> Right (RemovalCommandOp command.run (fmap T.pack safeWorkDir))+    Right safeWorkDir -> Right (RemovalCommandOp (command ^. #run) (fmap T.pack safeWorkDir))  validateRemovalPath :: Text -> Text -> Either RemovalError FilePath validateRemovalPath label path =@@ -205,12 +206,12 @@   exists <- doesFileExist path   if not exists     then pure RFGone-    else case Map.lookup path manifest.files of+    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+        if diskHash == rec ^. #hash           then pure RFSafe           else pure RFConflict @@ -223,8 +224,8 @@   UTCTime ->   Eff es Manifest executeRemovalOps manifest plan keepSet now = do-  let modName = plan.targetModule-  deletedPaths <- foldM (execOp modName keepSet) [] plan.ops+  let modName = (plan ^. #targetModule)+  deletedPaths <- foldM (execOp modName keepSet) [] (plan ^. #ops)   cleanupEmptyDirs deletedPaths   pure (removeFromManifest manifest modName now) @@ -283,7 +284,7 @@ -- | Find an applied module by name. findApplied :: Manifest -> ModuleName -> Maybe AppliedModule findApplied manifest modName =-  case filter (\am -> am.name == modName) manifest.modules of+  case filter (\am -> am ^. #name == modName) (manifest ^. #modules) of     (am : _) -> Just am     [] -> Nothing @@ -291,8 +292,8 @@ moduleFiles :: Manifest -> ModuleName -> [(FilePath, FileRecord)] moduleFiles manifest modName =   [ (path, rec)-  | (path, rec) <- Map.toList manifest.files,-    rec.moduleName == modName+  | (path, rec) <- Map.toList (manifest ^. #files),+    rec ^. #moduleName == modName   ]  -- | Classify a single file for removal (legacy).@@ -304,7 +305,7 @@     else do       content <- readFileText path       let diskHash = hashContent content-      if diskHash == rec.hash+      if diskHash == rec ^. #hash         then pure (RemovalSafe path)         else pure (RemovalConflict path) @@ -312,7 +313,7 @@ filesToDelete :: RemovalPlan -> Set FilePath -> [FilePath] filesToDelete plan keepSet =   [ path-  | rf <- plan.files,+  | rf <- plan ^. #files,     let path = removalFilePath rf,     shouldDelete rf,     not (Set.member path keepSet)@@ -350,7 +351,9 @@ 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-    }+    & #modules+    %~ filter (\am -> am ^. #name /= modName)+    & #files+    %~ Map.filter (\rec -> rec ^. #moduleName /= modName)+    & #genAt+    .~ now

@@ -8,28 +8,29 @@   ) where +import Data.Generics.Labels () 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+  { prefix :: !Text,+    module_ :: !ModuleName   }-  deriving stock (Eq, Show)+  deriving stock (Eq, Generic, Show)  -- | Render an opening section marker line. -- Result: @"# --- seihou:haskell-base ---\\n"@ renderSectionOpen :: SectionMarker -> Text renderSectionOpen marker =-  marker.sectionPrefix <> " --- seihou:" <> marker.sectionModule.unModuleName <> " ---\n"+  marker ^. #prefix <> " --- seihou:" <> marker ^. #module_ . #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"+  marker ^. #prefix <> " --- /seihou:" <> marker ^. #module_ . #unModuleName <> " ---\n"  -- | Wrap content in section markers. wrapInSection :: SectionMarker -> Text -> Text@@ -49,7 +50,7 @@ -- unchanged. Cleans up resulting double blank lines. removeSection :: ModuleName -> Text -> Text -> Text removeSection modName prefix content =-  let marker = SectionMarker {sectionPrefix = prefix, sectionModule = modName}+  let marker = SectionMarker {prefix = prefix, module_ = modName}       openTag = T.stripEnd (renderSectionOpen marker)       closeTag = T.stripEnd (renderSectionClose marker)       ls = T.lines content@@ -85,7 +86,7 @@ applyTextPatch PrependFile _ _ existing new =   Right (ensureTrailingNewline new <> existing) applyTextPatch AppendSection modName prefix existing new =-  let marker = SectionMarker {sectionPrefix = prefix, sectionModule = modName}+  let marker = SectionMarker {prefix = prefix, module_ = modName}    in Right (ensureTrailingNewline existing <> wrapInSection marker new) applyTextPatch AppendLineIfAbsent _ _ existing new =   let existingLines = map T.stripEnd (T.lines existing)

@@ -198,14 +198,15 @@     -- (i.e. the body plus whatever follows the matching @{{/if}}@);     -- @expr@ is the raw expression text.     FoundIf-      { foundBefore :: Text,-        foundAfter :: Text,-        foundExpr :: Text+      { before :: !Text,+        after :: !Text,+        expr :: !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+  deriving stock (Generic)  -- | 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@@ -225,9 +226,9 @@                   let expr = T.strip exprRaw                       afterCloseTag = T.drop 2 rest -- skip "}}"                    in FoundIf-                        { foundBefore = before,-                          foundAfter = afterCloseTag,-                          foundExpr = expr+                        { before = before,+                          after = afterCloseTag,+                          expr = expr                         }       | "{{/if}}" `T.isPrefixOf` t =           FoundOrphan "{{/if}}" (lineOffset (T.take pos input))

@@ -17,6 +17,7 @@ import Data.Aeson qualified as Aeson import Data.ByteString.Lazy qualified as LBS import Data.Foldable (traverse_)+import Data.Generics.Labels () import Data.List (sortOn) import Data.Map.Strict qualified as Map import Data.Set qualified as Set@@ -38,11 +39,11 @@ import System.IO.Temp (createTempDirectory, openTempFile)  data UpdateTransaction = UpdateTransaction-  { projectRoot :: FilePath,-    transactionDirectory :: FilePath,-    targets :: Set FilePath+  { projectRoot :: !FilePath,+    transactionDirectory :: !FilePath,+    targets :: !(Set FilePath)   }-  deriving stock (Eq, Show)+  deriving stock (Eq, Generic, Show)  data TransactionError   = InvalidTransactionPath FilePath Text@@ -57,25 +58,25 @@   deriving stock (Eq, Show)  data JournalEntry = JournalEntry-  { targetPath :: FilePath,-    backupFile :: Maybe FilePath+  { targetPath :: !FilePath,+    backupFile :: !(Maybe FilePath)   }-  deriving stock (Eq, Show)+  deriving stock (Eq, Generic, Show)  data JournalMetadata = JournalMetadata-  { journalVersion :: Int,-    createdAt :: UTCTime,-    entries :: [JournalEntry],-    newDirectories :: [FilePath],-    expectedManifest :: Maybe Manifest+  { journalVersion :: !Int,+    createdAt :: !UTCTime,+    entries :: ![JournalEntry],+    newDirectories :: ![FilePath],+    expectedManifest :: !(Maybe Manifest)   }-  deriving stock (Eq, Show)+  deriving stock (Eq, Generic, Show)  instance ToJSON JournalEntry where   toJSON entry =     Aeson.object-      [ "path" .= entry.targetPath,-        "backup" .= entry.backupFile+      [ "path" .= (entry ^. #targetPath),+        "backup" .= (entry ^. #backupFile)       ]  instance FromJSON JournalEntry where@@ -85,11 +86,11 @@ instance ToJSON JournalMetadata where   toJSON metadata =     Aeson.object-      [ "version" .= metadata.journalVersion,-        "createdAt" .= metadata.createdAt,-        "entries" .= metadata.entries,-        "newDirectories" .= metadata.newDirectories,-        "expectedManifest" .= metadata.expectedManifest+      [ "version" .= (metadata ^. #journalVersion),+        "createdAt" .= (metadata ^. #createdAt),+        "entries" .= (metadata ^. #entries),+        "newDirectories" .= (metadata ^. #newDirectories),+        "expectedManifest" .= (metadata ^. #expectedManifest)       ]  instance FromJSON JournalMetadata where@@ -118,10 +119,10 @@  initializeJournal :: UpdateTransaction -> [FilePath] -> IO () initializeJournal transaction safeTargets = do-  let backupDirectory = transaction.transactionDirectory </> "backups"+  let backupDirectory = transaction ^. #transactionDirectory </> "backups"   Directory.createDirectoryIfMissing True backupDirectory   entries <- forM (zip [0 :: Int ..] safeTargets) $ \(index, relativePath) -> do-    let fullPath = transaction.projectRoot </> relativePath+    let fullPath = transaction ^. #projectRoot </> relativePath         backupName = show index <> ".txt"         backupPath = backupDirectory </> backupName     exists <- Directory.doesFileExist fullPath@@ -130,10 +131,10 @@         TIO.readFile fullPath >>= TIO.writeFile backupPath         pure (JournalEntry relativePath (Just backupName))       else pure (JournalEntry relativePath Nothing)-  missingDirectories <- missingParentDirectories transaction.projectRoot safeTargets+  missingDirectories <- missingParentDirectories (transaction ^. #projectRoot) safeTargets   now <- getCurrentTime   writeJournal-    transaction.transactionDirectory+    (transaction ^. #transactionDirectory)     JournalMetadata       { journalVersion = 1,         createdAt = now,@@ -188,22 +189,22 @@                 Right () -> pure (Right candidate)  transactionPreflight :: UpdateTransaction -> ReconciliationPlan -> IO (Either TransactionError ())-transactionPreflight transaction plan = case traverse validateTransactionPath (Set.toAscList plan.requiredDirectories) of+transactionPreflight transaction plan = case traverse validateTransactionPath (Set.toAscList (plan ^. #requiredDirectories)) of   Left err -> pure (Left err)   Right _     | not (Set.null unjournaled) -> pure (Left (TransactionUnjournaledPaths unjournaled))     | not (Set.null unresolved) -> pure (Left (TransactionUnresolvedPaths unresolved))     | otherwise -> verifyObservedFiles transaction plan   where-    unjournaled = Map.keysSet plan.files Set.\\ transaction.targets+    unjournaled = Map.keysSet (plan ^. #files) Set.\\ (transaction ^. #targets)     unresolved = unresolvedPaths plan  verifyObservedFiles :: UpdateTransaction -> ReconciliationPlan -> IO (Either TransactionError ())-verifyObservedFiles transaction plan = go (Map.toAscList plan.files)+verifyObservedFiles transaction plan = go (Map.toAscList (plan ^. #files))   where     go [] = pure (Right ())     go ((path, reconciliation) : rest) = do-      current <- observeDiskFile (transaction.projectRoot </> path)+      current <- observeDiskFile (transaction ^. #projectRoot </> path)       let planned = reconciliationObservation reconciliation       if current == planned         then go rest@@ -232,23 +233,23 @@  prepareCandidateManifest :: UpdateTransaction -> ReconciliationPlan -> Manifest -> IO Manifest prepareCandidateManifest transaction plan manifest = do-  nextFiles <- foldM applyManifestAction manifest.files (Map.toAscList plan.files)+  nextFiles <- foldM applyManifestAction (manifest ^. #files) (Map.toAscList (plan ^. #files))   pure (replaceManifestFiles manifest nextFiles)   where     applyManifestAction files (path, reconciliation) = case desiredState reconciliation of       Just (desired, state) -> do-        baseline <- writeBaselineBlob transaction.projectRoot state.generatedBaseline+        baseline <- writeBaselineBlob (transaction ^. #projectRoot) (state ^. #generatedBaseline)         let record =               FileRecord-                { hash = state.recordedHash,-                  moduleName = desired.moduleName,-                  strategy = desired.strategy,-                  generatedAt = manifest.genAt,+                { hash = state ^. #recordedHash,+                  moduleName = desired ^. #moduleName,+                  strategy = desired ^. #strategy,+                  generatedAt = manifest ^. #genAt,                   baseline = Just baseline,-                  applicationIds = desired.applicationIds+                  applicationIds = desired ^. #applicationIds                 }         pure (Map.insert path record files)-      Nothing -> pure (applyOrphanManifestAction plan.applicationIds reconciliation files)+      Nothing -> pure (applyOrphanManifestAction (plan ^. #applicationIds) reconciliation files)  desiredState :: FileReconciliation -> Maybe (DesiredFile, PlannedFileState) desiredState reconciliation = case reconciliation of@@ -256,7 +257,7 @@   FileUpdate desired state _ _ -> Just (desired, state)   FileAutoMerge desired state _ _ -> Just (desired, state)   FileUnchanged desired state _ _ -> Just (desired, state)-  FileConflict desired _ _ _ _ _ (Just resolution) -> Just (desired, resolution.state)+  FileConflict desired _ _ _ _ _ (Just resolution) -> Just (desired, resolution ^. #state)   _ -> Nothing  applyOrphanManifestAction ::@@ -268,14 +269,14 @@   FileDeleteSafe path _ _ -> Map.delete path files   FileAlreadyAbsent path _ _ -> Map.delete path files   FileReleaseSharedOwnership path record _ ->-    let remaining = record.applicationIds Set.\\ selected+    let remaining = (record ^. #applicationIds) Set.\\ selected      in if Set.null remaining           then Map.delete path files           else Map.insert path (replaceRecordApplications record remaining) files   FileOrphanEdited path _ _ _ (Just DeleteEditedOrphan) -> Map.delete path files   FileOrphanEdited _ _ _ _ (Just RetainTrackedOrphan) -> files   FileOrphanEdited path record _ _ (Just DetachAndKeepOrphan) ->-    let remaining = record.applicationIds Set.\\ selected+    let remaining = (record ^. #applicationIds) Set.\\ selected      in if Set.null remaining           then Map.delete path files           else Map.insert path (replaceRecordApplications record remaining) files@@ -284,26 +285,26 @@ replaceRecordApplications :: FileRecord -> Set ApplicationId -> FileRecord replaceRecordApplications record owners =   FileRecord-    { hash = record.hash,-      moduleName = record.moduleName,-      strategy = record.strategy,-      generatedAt = record.generatedAt,-      baseline = record.baseline,+    { hash = record ^. #hash,+      moduleName = record ^. #moduleName,+      strategy = record ^. #strategy,+      generatedAt = record ^. #generatedAt,+      baseline = record ^. #baseline,       applicationIds = owners     }  replaceManifestFiles :: Manifest -> Map FilePath FileRecord -> Manifest replaceManifestFiles manifest nextFiles =   Manifest-    { version = manifest.version,-      genAt = manifest.genAt,-      modules = manifest.modules,-      vars = manifest.vars,+    { version = manifest ^. #version,+      genAt = manifest ^. #genAt,+      modules = manifest ^. #modules,+      vars = manifest ^. #vars,       files = nextFiles,-      applications = manifest.applications,-      recipe = manifest.recipe,-      blueprint = manifest.blueprint,-      blueprintMigrations = manifest.blueprintMigrations+      applications = manifest ^. #applications,+      recipe = manifest ^. #recipe,+      blueprint = manifest ^. #blueprint,+      blueprintMigrations = manifest ^. #blueprintMigrations     }  writeBaselineBlob :: FilePath -> Text -> IO BaselineRef@@ -313,50 +314,50 @@  updateJournalForPlan :: UpdateTransaction -> ReconciliationPlan -> Manifest -> IO (Either TransactionError ()) updateJournalForPlan transaction plan candidate = do-  metadataResult <- readJournal transaction.transactionDirectory+  metadataResult <- readJournal (transaction ^. #transactionDirectory)   case metadataResult of     Left err -> pure (Left err)     Right metadata -> do       missingDirectories <-         filterMIO-          (fmap not . Directory.doesDirectoryExist . (transaction.projectRoot </>))+          (fmap not . Directory.doesDirectoryExist . (transaction ^. #projectRoot </>))           ( Set.toAscList . Set.fromList $               concatMap                 (\path -> path : relativeParents path)-                (Set.toAscList plan.requiredDirectories)+                (Set.toAscList (plan ^. #requiredDirectories))           )       let updated = setExpectedManifestAndDirectories metadata missingDirectories candidate-      result <- try @SomeException $ writeJournal transaction.transactionDirectory updated+      result <- try @SomeException $ writeJournal (transaction ^. #transactionDirectory) updated       pure $ first (\err -> TransactionApplyFailed (exceptionText err) Nothing) result  setExpectedManifestAndDirectories :: JournalMetadata -> [FilePath] -> Manifest -> JournalMetadata setExpectedManifestAndDirectories metadata additionalDirectories candidate =   JournalMetadata-    { journalVersion = metadata.journalVersion,-      createdAt = metadata.createdAt,-      entries = metadata.entries,+    { journalVersion = metadata ^. #journalVersion,+      createdAt = metadata ^. #createdAt,+      entries = metadata ^. #entries,       newDirectories =         sortOn pathDepth . Set.toList $-          Set.fromList (metadata.newDirectories <> additionalDirectories),+          Set.fromList (metadata ^. #newDirectories <> additionalDirectories),       expectedManifest = Just candidate     }  applyMutations :: (Int -> IO ()) -> UpdateTransaction -> ReconciliationPlan -> IO () applyMutations afterMutation transaction plan = do-  forM_ (Set.toAscList plan.requiredDirectories) $ \relativePath ->-    Directory.createDirectoryIfMissing True (transaction.projectRoot </> relativePath)-  _ <- foldM applyOne (0 :: Int) (Map.toAscList plan.files)+  forM_ (Set.toAscList (plan ^. #requiredDirectories)) $ \relativePath ->+    Directory.createDirectoryIfMissing True (transaction ^. #projectRoot </> relativePath)+  _ <- foldM applyOne (0 :: Int) (Map.toAscList (plan ^. #files))   pure ()   where     applyOne count (path, reconciliation) = case mutationFor reconciliation of       NoMutation -> pure count       WriteMutation content -> do-        atomicWriteText (transaction.projectRoot </> path) content+        atomicWriteText (transaction ^. #projectRoot </> path) content         let next = count + 1         afterMutation next         pure next       DeleteMutation -> do-        let fullPath = transaction.projectRoot </> path+        let fullPath = transaction ^. #projectRoot </> path         exists <- Directory.doesFileExist fullPath         when exists (Directory.removeFile fullPath)         let next = count + 1@@ -368,7 +369,7 @@ mutationFor :: FileReconciliation -> FileMutation mutationFor reconciliation = case desiredState reconciliation of   Just (_, state)-    | state.writeToDisk -> WriteMutation state.appliedContent+    | state ^. #writeToDisk -> WriteMutation (state ^. #appliedContent)     | otherwise -> NoMutation   Nothing -> case reconciliation of     FileDeleteSafe _ _ _ -> DeleteMutation@@ -377,25 +378,25 @@  rollbackUpdateTransaction :: UpdateTransaction -> IO (Either TransactionError ()) rollbackUpdateTransaction transaction = do-  metadataResult <- readJournal transaction.transactionDirectory+  metadataResult <- readJournal (transaction ^. #transactionDirectory)   case metadataResult of     Left err -> pure (Left err)     Right metadata -> do       result <- try @SomeException $ do-        forM_ metadata.entries (restoreEntry transaction)-        removeNewDirectories transaction.projectRoot metadata.newDirectories-        cleanupDirectory transaction.transactionDirectory+        forM_ (metadata ^. #entries) (restoreEntry transaction)+        removeNewDirectories (transaction ^. #projectRoot) (metadata ^. #newDirectories)+        cleanupDirectory (transaction ^. #transactionDirectory)       pure $ first (TransactionRollbackFailed . exceptionText) result  restoreEntry :: UpdateTransaction -> JournalEntry -> IO () restoreEntry transaction entry = do-  let target = transaction.projectRoot </> entry.targetPath-  case entry.backupFile of+  let target = transaction ^. #projectRoot </> (entry ^. #targetPath)+  case entry ^. #backupFile of     Nothing -> do       exists <- Directory.doesFileExist target       when exists (Directory.removeFile target)     Just backupName -> do-      let backupPath = transaction.transactionDirectory </> "backups" </> backupName+      let backupPath = transaction ^. #transactionDirectory </> "backups" </> backupName       content <- TIO.readFile backupPath       atomicWriteText target content @@ -411,7 +412,7 @@  completeUpdateTransaction :: UpdateTransaction -> IO (Either TransactionError ()) completeUpdateTransaction transaction = do-  result <- try @SomeException (cleanupDirectory transaction.transactionDirectory)+  result <- try @SomeException (cleanupDirectory (transaction ^. #transactionDirectory))   pure $ first (TransactionCompletionFailed . exceptionText) result  -- | Replace the recovery commit marker with the exact manifest the caller is@@ -420,19 +421,19 @@ -- candidate before the atomic manifest write. setUpdateTransactionExpectedManifest :: UpdateTransaction -> Manifest -> IO (Either TransactionError ()) setUpdateTransactionExpectedManifest transaction expected = do-  metadataResult <- readJournal transaction.transactionDirectory+  metadataResult <- readJournal (transaction ^. #transactionDirectory)   case metadataResult of     Left err -> pure (Left err)     Right metadata -> do       let updated =             JournalMetadata-              { journalVersion = metadata.journalVersion,-                createdAt = metadata.createdAt,-                entries = metadata.entries,-                newDirectories = metadata.newDirectories,+              { journalVersion = metadata ^. #journalVersion,+                createdAt = metadata ^. #createdAt,+                entries = metadata ^. #entries,+                newDirectories = metadata ^. #newDirectories,                 expectedManifest = Just expected               }-      result <- try @SomeException (writeJournal transaction.transactionDirectory updated)+      result <- try @SomeException (writeJournal (transaction ^. #transactionDirectory) updated)       pure $ first (\err -> TransactionApplyFailed (exceptionText err) Nothing) result  recoverIncompleteTransactions :: FilePath -> IO [Either TransactionError ()]@@ -460,7 +461,7 @@         Left quarantineError -> Left quarantineError         Right () -> Left err     Right metadata -> do-      committed <- manifestMatches projectRoot metadata.expectedManifest+      committed <- manifestMatches projectRoot (metadata ^. #expectedManifest)       if committed         then do           result <- try @SomeException (cleanupDirectory transactionDirectory)@@ -470,7 +471,7 @@             UpdateTransaction               { projectRoot = projectRoot,                 transactionDirectory = transactionDirectory,-                targets = Set.fromList (map (.targetPath) metadata.entries)+                targets = Set.fromList (map (^. #targetPath) (metadata ^. #entries))               }  manifestMatches :: FilePath -> Maybe Manifest -> IO Bool@@ -507,9 +508,9 @@  validateJournal :: JournalMetadata -> Either Text JournalMetadata validateJournal metadata = do-  traverse_ (validateJournalEntry . (.targetPath)) metadata.entries-  traverse_ validateBackupName [name | JournalEntry _ (Just name) <- metadata.entries]-  traverse_ (first renderTransactionPathError . validateTransactionPath) metadata.newDirectories+  traverse_ (validateJournalEntry . (^. #targetPath)) (metadata ^. #entries)+  traverse_ validateBackupName [name | JournalEntry _ (Just name) <- metadata ^. #entries]+  traverse_ (first renderTransactionPathError . validateTransactionPath) (metadata ^. #newDirectories)   pure metadata   where     validateJournalEntry path = first renderTransactionPathError (validateTransactionPath path)

@@ -8,6 +8,7 @@   ) where +import Data.Generics.Labels () import Data.Map.Strict qualified as Map import Data.Maybe (isNothing, mapMaybe) import Data.Set qualified as Set@@ -40,21 +41,21 @@  -- | A single diagnostic check with its result. data DiagCheck = DiagCheck-  { diagLabel :: Text,-    diagSeverity :: DiagSeverity,-    diagDetails :: [Text]+  { label :: !Text,+    severity :: !DiagSeverity,+    details :: ![Text]   }-  deriving stock (Eq, Show)+  deriving stock (Eq, Generic, Show)  -- | A complete validation report for a module. data ValidateReport = ValidateReport-  { reportModule :: Module,-    reportPath :: FilePath,-    reportDhallOk :: Bool,-    reportDhallError :: Maybe Text,-    reportChecks :: [DiagCheck]+  { module_ :: !Module,+    path :: !FilePath,+    dhallOk :: !Bool,+    dhallError :: !(Maybe Text),+    checks :: ![DiagCheck]   }-  deriving stock (Eq, Show)+  deriving stock (Eq, Generic, Show)  -- | Build a structured validation report. When the first argument is True, -- lint warnings are included after the core checks.@@ -94,24 +95,24 @@           else []   pure     ValidateReport-      { reportModule = m,-        reportPath = baseDir,-        reportDhallOk = True,-        reportDhallError = Nothing,-        reportChecks = coreChecks ++ lintChecks+      { module_ = m,+        path = baseDir,+        dhallOk = True,+        dhallError = Nothing,+        checks = 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+  not (report ^. #dhallOk)+    || any (\c -> c ^. #severity == DiagError && not (null (c ^. #details))) (report ^. #checks)  -- | Render the report as plain text (no ANSI codes). renderReportPlain :: ValidateReport -> Text renderReportPlain report =   T.unlines $-    [ "Validating module at " <> T.pack report.reportPath <> "...",+    [ "Validating module at " <> T.pack (report ^. #path) <> "...",       ""     ]       ++ dhallLine@@ -120,46 +121,46 @@       ++ [""]       ++ [resultLine]   where-    m = report.reportModule+    m = (report ^. #module_)      dhallLine =-      if report.reportDhallOk+      if report ^. #dhallOk         then ["  \x2713 module.dhall evaluates successfully"]         else           ["  \x2717 module.dhall failed to evaluate"]-            ++ case report.reportDhallError of+            ++ case report ^. #dhallError of               Just errText -> ["      " <> errText]               Nothing -> []      summaryLines =-      if report.reportDhallOk+      if report ^. #dhallOk         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"+          [ "  \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+    checkLines = concatMap renderCheck (report ^. #checks)      renderCheck c-      | null c.diagDetails =-          ["  \x2713 " <> c.diagLabel]-      | c.diagSeverity == DiagWarning =-          ("  \x26A0 " <> c.diagLabel) : map (\d -> "      " <> d) c.diagDetails+      | null (c ^. #details) =+          ["  \x2713 " <> c ^. #label]+      | c ^. #severity == DiagWarning =+          ("  \x26A0 " <> c ^. #label) : map (\d -> "      " <> d) (c ^. #details)       | otherwise =-          ("  \x2717 " <> c.diagLabel) : map (\d -> "      " <> d) c.diagDetails+          ("  \x2717 " <> c ^. #label) : map (\d -> "      " <> d) (c ^. #details)      errorCount =       length         [ ()-        | c <- report.reportChecks,-          c.diagSeverity == DiagError,-          not (null c.diagDetails)+        | c <- report ^. #checks,+          c ^. #severity == DiagError,+          not (null (c ^. #details))         ] -    dhallFailed = not report.reportDhallOk+    dhallFailed = not (report ^. #dhallOk)      totalErrors = errorCount + (if dhallFailed then 1 else 0) @@ -167,7 +168,7 @@       | totalErrors > 0 =           T.pack (show totalErrors) <> " error(s) found. Module is invalid."       | otherwise =-          "Module '" <> m.name.unModuleName <> "' is valid."+          "Module '" <> m ^. #name . #unModuleName <> "' is valid."  -- Lint checks @@ -176,40 +177,40 @@ lintUnusedVars m =   let destRefs =         Set.fromList $-          concatMap (extractPlaceholders . (.dest)) m.steps+          concatMap (extractPlaceholders . (^. #dest)) (m ^. #steps)       exportRefs =         Set.fromList $-          map (.var.unVarName) m.exports+          map (^. #var . #unVarName) (m ^. #exports)       promptRefs =         Set.fromList $-          map (.var.unVarName) m.prompts+          map (^. #var . #unVarName) (m ^. #prompts)       allRefs = Set.unions [destRefs, exportRefs, promptRefs]    in mapMaybe         ( \v ->-            let name' = v.name.unVarName+            let name' = (v ^. #name . #unVarName)              in if Set.member name' allRefs                   then Nothing                   else Just ("variable '" <> name' <> "' is declared but never referenced")         )-        m.vars+        (m ^. #vars)  -- | Required variables that have no corresponding prompt. lintRequiredWithoutPrompt :: Module -> [Text] lintRequiredWithoutPrompt m =-  let promptedVars = Set.fromList $ map (.var.unVarName) m.prompts+  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)+            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+        (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]+  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 @@ -224,22 +225,22 @@ lintEmptyChoices :: Module -> [Text] lintEmptyChoices m =   mapMaybe-    ( \v -> case v.type_ of-        VTChoice [] -> Just ("variable '" <> v.name.unVarName <> "' has an empty choice list")+    ( \v -> case v ^. #type_ of+        VTChoice [] -> Just ("variable '" <> v ^. #name . #unVarName <> "' has an empty choice list")         _ -> Nothing     )-    m.vars+    (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")+        if isNothing (v ^. #description)+          then Just ("variable '" <> v ^. #name . #unVarName <> "' has no description")           else Nothing     )-    m.vars+    (m ^. #vars)  -- Conditional-expression lint (when clauses + template {{#if}} conditionals) @@ -261,15 +262,15 @@ 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]+  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]]+        [("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]]+        [("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]+        [ ("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@@ -287,20 +288,20 @@ collectTemplateExprs baseDir m =   concat <$> mapM readStep textBearingSteps   where-    textBearingSteps = filter (isTextBearing . (.strategy)) m.steps+    textBearingSteps = filter (isTextBearing . (^. #strategy)) (m ^. #steps)      isTextBearing Template = True     isTextBearing DhallText = True     isTextBearing _ = False      readStep s = do-      let path = baseDir </> "files" </> s.src+      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"+          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.@@ -311,7 +312,7 @@     checkRef (name, mLit) =       case Map.lookup name declaredTypes of         Nothing ->-          [CondUndeclared (srcLabel <> " references undeclared variable: " <> name.unVarName)]+          [CondUndeclared (srcLabel <> " references undeclared variable: " <> name ^. #unVarName)]         Just ty -> case mLit of           Just lit             | not (literalMatchesType ty lit) ->@@ -337,7 +338,7 @@ describeMismatch srcLabel name ty lit =   srcLabel     <> " compares variable '"-    <> name.unVarName+    <> name ^. #unVarName     <> "' (declared type "     <> renderVarType ty     <> ") against "

@@ -4,6 +4,7 @@ where  import Control.Monad (foldM)+import Data.Generics.Labels () import Data.Map.Strict qualified as Map import Seihou.Composition.Instance (ModuleInstance (..)) import Seihou.Core.Types@@ -43,7 +44,7 @@ anyNeedsConfirm = any (any isDefaultOrParent) . Map.elems  isDefaultOrParent :: ResolvedVar -> Bool-isDefaultOrParent rv = case rv.source of+isDefaultOrParent rv = case rv ^. #source of   FromDefault -> True   FromParent _ -> True   _ -> False@@ -55,7 +56,7 @@   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+  newModResolved <- foldM (processVar m acc) modResolved (m ^. #vars)   pure (Map.insert inst newModResolved acc)  processVar ::@@ -66,29 +67,29 @@   VarDecl ->   Eff es (Map VarName ResolvedVar) processVar m allResolved modResolved decl =-  case Map.lookup decl.name modResolved of+  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))+            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)+          | 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+  case filter (\p -> p ^. #var == decl ^. #name) (m ^. #prompts) of     (p : _) -> p     [] ->       Prompt-        { var = decl.name,-          text = decl.name.unVarName,+        { var = decl ^. #name,+          text = decl ^. #name . #unVarName,           condition = Nothing,           choices = Nothing         }

@@ -4,6 +4,7 @@   ) where +import Data.Generics.Labels () import Data.Map.Strict qualified as Map import Data.Text qualified as T import Seihou.Core.Expr (evalExpr)@@ -32,12 +33,12 @@ runPrompts prompts unresolvedDecls currentBindings =   go prompts Map.empty   where-    declMap = Map.fromList [(d.name, d) | d <- unresolvedDecls]+    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+      let vn = (p ^. #var)       -- Skip if variable is not in the unresolved set       case Map.lookup vn declMap of         Nothing -> go ps acc@@ -47,7 +48,7 @@             then go ps acc             else do               -- Evaluate when condition-              let allBindings = Map.union (Map.map (.value) acc) currentBindings+              let allBindings = Map.union (Map.map (^. #value) acc) currentBindings               if shouldPrompt p allBindings                 then do                   result <- promptForVar p decl allBindings@@ -59,7 +60,7 @@ -- | 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+  case p ^. #condition of     Nothing -> True     Just expr -> evalExpr bindings expr @@ -73,7 +74,7 @@   Map VarName VarValue ->   Eff es (Either VarError ResolvedVar) promptForVar prompt decl _bindings =-  case prompt.choices of+  case prompt ^. #choices of     Just choices -> promptWithChoices prompt decl choices     Nothing -> promptFreeText prompt decl 3 @@ -92,7 +93,7 @@   putText (formatPromptText prompt decl)   raw <- getLine   if T.null (T.strip raw)-    then case decl.default_ of+    then case decl ^. #default_ of       Just defVal ->         -- Accept the default value         pure@@ -104,14 +105,14 @@                 }           )       Nothing-        | not decl.required ->+        | not (decl ^. #required) ->             -- Optional variable with no default — skip-            pure (Left (MissingRequiredVar decl.name))+            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))+            pure (Left (MissingRequiredVar (decl ^. #name)))     else case coerceAndValidate decl raw of       Left err ->         if retriesLeft > 1@@ -129,7 +130,7 @@   [Text] ->   Eff es (Either VarError ResolvedVar) promptWithChoices prompt decl choices = do-  putText prompt.text+  putText (prompt ^. #text)   mapM_ (\(i, c) -> putText ("  " <> T.pack (show i) <> ") " <> c)) (zip [1 :: Int ..] choices)   putText "Enter selection number:"   raw <- getLine@@ -151,12 +152,12 @@                in case coerceAndValidate decl chosen of                     Left err -> pure (Left err)                     Right rv -> pure (Right rv)-        _ -> pure (Left (MissingRequiredVar decl.name))+        _ -> 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+  val <- coerceValue (decl ^. #name) (decl ^. #type_) raw   validateVarValue decl val   pure     ResolvedVar@@ -185,11 +186,11 @@ -- 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 <> "]:"+  case decl ^. #default_ of+    Just defVal -> prompt ^. #text <> " [" <> showDefaultValue defVal <> "]:"     Nothing-      | not decl.required -> prompt.text <> " [skip]:"-      | otherwise -> prompt.text+      | not (decl ^. #required) -> prompt ^. #text <> " [skip]:"+      | otherwise -> (prompt ^. #text)  -- | Render a VarValue for display in a prompt's default hint. showDefaultValue :: VarValue -> Text