diff --git a/data/module-reference.md b/data/module-reference.md --- a/data/module-reference.md +++ b/data/module-reference.md @@ -220,3 +220,12 @@ Recipe inheritance producers require Seihou 0.14.0.0 or newer. Update the runtime before adopting descriptors that use `extends` or inherited overrides. + +## Conditional removal in composed modules + +`RemovalStep.when` uses the generation expression grammar and is evaluated against +the owning instance's recorded resolved variables. A base suppressing starter +outputs must apply the same condition to their cleanup steps. Omitted conditions +remain unconditional. Require Seihou 0.15.0.0+ before publishing these descriptors. +A recorded single-module root removes its unshared inherited instances in the same +operation; shared qualified instances remain owned by surviving applications. diff --git a/data/setup-prompt.md b/data/setup-prompt.md --- a/data/setup-prompt.md +++ b/data/setup-prompt.md @@ -123,9 +123,10 @@ - `-c CTX`: override context for config lookup - `--no-commands`: skip shell command steps - `seihou remove MODULE [--dry-run] [--force]` — remove an applied module by executing its declared removal steps + - A recorded single-module root also retires its unshared inherited modules; other applications retain shared instances. - Managed-file removal needs a `removal` section; recorded seed-only/checkout-only owners can be removed without a custom spec. Seed retirement keeps project files. Removal stops future setup and does not undo arbitrary shell effects. - `--dry-run`: preview the removal plan (Delete, Strip, Rewrite, Run, and protected Keep operations) - - `--force`: skip confirmation prompts + - `--force`: accept conflicted managed-file deletions; seeds remain protected - `seihou agent run BLUEPRINT [PROMPT] [--var K=V] [--no-baseline]` — run a blueprint - Discovers the blueprint, resolves variables (same precedence chain as `seihou run`), optionally applies base modules, then starts the configured provider - `--no-baseline`: skip applying declared base modules diff --git a/help/manifest.md b/help/manifest.md --- a/help/manifest.md +++ b/help/manifest.md @@ -65,8 +65,9 @@ 10 -> 11 precise seed ownership claims 11 -> 12 recipe inputs 12 -> 13 unknown recipe-chain history + 13 -> 14 conditional removal policies and recorded root retirement - ✓ Upgraded .seihou/manifest.json to schema version 13. + ✓ Upgraded .seihou/manifest.json to schema version 14. Review the diff and commit it: git diff .seihou/manifest.json Running it on a manifest that is already current reports that there is @@ -164,3 +165,19 @@ the old manifest. Metadata-only base changes need acceptance, and unchanged application command receipts remain valid. Use the normal recipe update to adopt unknown history; no manual manifest editing is required. + +CONDITIONAL REMOVAL POLICIES + + Schema 14 records the conditional-removal/root-retirement boundary. Omitted + removal conditions remain unconditional. Each application instance records + removalPolicy with typed Boolean condition results at accepted run/update. + The adjacent upgrade records null for unknown historical policies, changes no + project files, and invents no result. A schema-13 document carrying policy + evidence is rejected. Ordinary run/update/removal prepare this + lossless boundary in memory; previews do not publish it. A conditional legacy + application without accepted policy evidence needs its ordinary update first. + + A recorded single-module root retires unshared inherited modules in the same + removal. Other applications keep shared qualified instances. Explicit + additional-root compositions and recipe applications retain exact-instance + selection. See seihou help modules. diff --git a/help/modules.md b/help/modules.md --- a/help/modules.md +++ b/help/modules.md @@ -127,3 +127,12 @@ working directories real and project-relative. Ordinary receipts never suppress checkout commands. `--no-commands` suppresses both lifecycles while retaining setup; a true no-op update executes neither. Removal accepts application commands only. + +Removing a recorded application with one module root also retires its unshared +inherited modules in the same operation. Other applications keep shared qualified +instances. Seeds remain protected throughout inherited cleanup. Explicit compositions +with additional roots and recipe applications keep exact-instance selection. + +Removal steps may declare `when`, using the generation expression grammar. It is +evaluated against that instance's saved resolved values. Older omitted conditions +remain unconditional. This policy requires the schema-14 runtime. diff --git a/help/update.md b/help/update.md --- a/help/update.md +++ b/help/update.md @@ -93,9 +93,14 @@ Recipe applications also reuse recorded recipe inputs before member variables. Inputs used only by conditions survive fresh clones. Ordinary preview prepares - schema 13 as needed and adopts agreeing historical values; conflicting or newly + schema 14 as needed and adopts agreeing historical values; conflicting or newly required choices need --var KEY=VALUE or --reconfigure. Recipe-only changes are recorded even when no generated file changes. + + Accepted update also records each instance's removal policy with typed Boolean + condition results. Policy-only adoption appears in the preview and is a real + update; repeating it with matching policies is a no-op. No manual manifest + edits are needed. MIGRATIONS diff --git a/help/workflow.md b/help/workflow.md --- a/help/workflow.md +++ b/help/workflow.md @@ -58,7 +58,9 @@ seihou remove NAME Managed-file removal follows the module's removal declaration and protects - conflicts. Recorded seed-only/checkout-only owners need no custom spec; seed + conflicts. Removing a recorded single-module root also retires its unshared + inherited modules; other applications keep shared instances. Recorded + seed-only/checkout-only owners need no custom spec; seed retirement preserves files. Status/diff count seeds without content comparisons. Review changes and commit portable manifest/config, real source directories and ignore rules. Accepted link adoption can stage tracked-link removals. diff --git a/seihou-cli.cabal b/seihou-cli.cabal --- a/seihou-cli.cabal +++ b/seihou-cli.cabal @@ -1,6 +1,6 @@ cabal-version: 3.0 name: seihou-cli -version: 0.14.0.0 +version: 0.15.0.0 synopsis: CLI for Seihou project scaffolding description: Command-line interface for Seihou, a composable project scaffolding @@ -144,7 +144,7 @@ generic-lens >=2.2 && <3, lens >=5.2 && <6, process >=1.6 && <2, - seihou-core ^>=0.14.0.0, + seihou-core ^>=0.15.0.0, streamly-core >=0.3 && <0.5, temporary >=1.3 && <2, text >=2.0 && <3, @@ -233,7 +233,7 @@ optparse-applicative >=0.18 && <1, process >=1.6 && <2, seihou-cli-internal, - seihou-core ^>=0.14.0.0, + seihou-core ^>=0.15.0.0, temporary >=1.3 && <2, text >=2.0 && <3, time >=1.12 && <2, @@ -330,7 +330,7 @@ lens >=5.2 && <6, process >=1.6 && <2, seihou-cli-internal, - seihou-core ^>=0.14.0.0, + seihou-core ^>=0.15.0.0, streamly-core >=0.3 && <0.5, tasty >=1.4 && <2, tasty-hspec >=1.2 && <2, diff --git a/src-exe/Seihou/CLI/Commands.hs b/src-exe/Seihou/CLI/Commands.hs --- a/src-exe/Seihou/CLI/Commands.hs +++ b/src-exe/Seihou/CLI/Commands.hs @@ -653,7 +653,9 @@ ( Just $ vsep [ pretty ("Removes a module that was previously applied via 'seihou run' and" :: String), - pretty ("reverses its declared effects. Managed files require a removal" :: String), + pretty ("reverses its declared effects. A recorded single-module root also" :: String), + pretty ("retires its unshared inherited modules. Shared instances remain." :: String), + pretty ("Managed files require a removal" :: String), pretty ("specification. Seed-only ownership can be retired without one; seed" :: String), pretty ("files and their deliberate deletion are preserved, even with --force." :: String), line, diff --git a/src-exe/Seihou/CLI/Remove.hs b/src-exe/Seihou/CLI/Remove.hs --- a/src-exe/Seihou/CLI/Remove.hs +++ b/src-exe/Seihou/CLI/Remove.hs @@ -13,7 +13,7 @@ import Data.Time.Clock (getCurrentTime) import Seihou.CLI.CheckoutSync (renderCheckoutPlan) import Seihou.CLI.Commands (RemoveOpts (..)) -import Seihou.CLI.ManifestCapabilityUpgrade (prepareRecordedSeedOwnership) +import Seihou.CLI.ManifestCapabilityUpgrade (prepareRecordedSeedOwnership, prepareRemovalPolicies) import Seihou.CLI.Style (bold, dim, green, useColor, yellow) import Seihou.Composition.Instance (ModuleInstance (..), qualifiedName) import Seihou.Core.Checkout @@ -51,7 +51,8 @@ let matchingApps = Set.fromList [app ^. #applicationId | app <- originalManifest ^. #applications, maybe True (== app ^. #applicationId) (opts ^. #application), state <- app ^. #instances, modName == state ^. #name || modName == qualifiedName (ModuleInstance (state ^. #name) (state ^. #parentVars))] legacyPaths = Set.fromList [path | (path, receipt) <- Map.toAscList (originalManifest ^. #seeds), LegacySeedOwners apps <- [receipt ^. #ownership], not (Set.null (apps `Set.intersection` matchingApps))] prepared <- prepareRecordedSeedOwnership root paths legacyPaths originalManifest - manifest <- case prepared of Left err -> TIO.putStrLn err >> exitFailure; Right candidate -> pure candidate + seedPrepared <- case prepared of Left err -> TIO.putStrLn err >> exitFailure; Right candidate -> pure candidate + manifest <- case prepareRemovalPolicies seedPrepared of Left err -> TIO.putStrLn err >> exitFailure; Right candidate -> pure candidate case selectRecordedRemoval manifest modName (opts ^. #application) of Left err -> TIO.putStrLn (err ^. #message) >> exitFailure Right (Just selected) -> handleCheckoutRemoval opts manifest selected >> exitWith ExitSuccess @@ -221,7 +222,14 @@ handleCheckoutRemoval opts manifest selected = do root <- getCurrentDirectory let candidate = selected ^. #candidateManifest - retiredSeeds = [path | (path, receipt) <- Map.toAscList (manifest ^. #seeds), case receipt ^. #ownership of KnownSeedOwners owners -> Set.member (selected ^. #instanceName) (Map.findWithDefault Set.empty (selected ^. #applicationId) owners); _ -> False] + ownersFor path source = case Map.lookup path (source ^. #seeds) of + Just receipt -> case receipt ^. #ownership of KnownSeedOwners owners -> Map.findWithDefault Set.empty (selected ^. #applicationId) owners; _ -> Set.empty + Nothing -> Set.empty + retiredSeeds = [path | path <- Map.keys (manifest ^. #seeds), not (Set.null (ownersFor path manifest `Set.difference` ownersFor path candidate))] + qualified applied = qualifiedName (ModuleInstance (applied ^. #name) (applied ^. #parentVars)) + retainedModules = Set.fromList (map qualified (candidate ^. #modules)) + inherited = [qualified applied | applied <- manifest ^. #modules, not (Set.member (qualified applied) retainedModules), qualified applied /= selected ^. #instanceName] + mapM_ (\name -> TIO.putStrLn (" Retire inherited module " <> name ^. #unModuleName <> ".")) inherited mapM_ (\path -> TIO.putStrLn (" Keep " <> T.pack path <> " (seed file; owned by the project)")) (take 5 retiredSeeds) checked <- runEff $ runFilesystem $ runProcessIO $ prepareCheckoutPlan Reconcile ApplyDeclaration root manifest candidate [] plan <- case checked of diff --git a/src-exe/Seihou/CLI/Run.hs b/src-exe/Seihou/CLI/Run.hs --- a/src-exe/Seihou/CLI/Run.hs +++ b/src-exe/Seihou/CLI/Run.hs @@ -64,6 +64,7 @@ import Seihou.Core.Checkout import Seihou.Core.CommandFingerprint (checkoutCommandsFromOperations, isCheckoutCommand) import Seihou.Core.Context (resolveContext) +import Seihou.Core.Expr (settleRemovalConditions) import Seihou.Core.Migration (MigrationPlan (..)) import Seihou.Core.Module (defaultSearchPaths, discoverRunnable) import Seihou.Core.Seed (renderSeedOwnershipError, replaceSelectedSeedClaims) @@ -513,7 +514,7 @@ -- Build updated manifest with all composed modules. let orphanedPaths = map (^. #path) (diff ^. #orphaned) cleanedFiles = foldr Map.delete (manifest ^. #files) orphanedPaths - allModuleEntries = updateAllModules (manifest ^. #modules) originedModules now + allModuleEntries = updateAllModules (manifest ^. #modules) originedModules resolved now allResolvedVals = Map.unions [Map.map (^. #value) vs | vs <- Map.elems resolved] @@ -996,9 +997,10 @@ updateAllModules :: [AppliedModule] -> [(ModuleInstance, Module, ArtifactOrigin)] -> + Map ModuleInstance (Map VarName ResolvedVar) -> UTCTime -> [AppliedModule] -updateAllModules existing modulesInOrder now = +updateAllModules existing modulesInOrder resolved now = let composedKeys = Set.fromList [ (inst ^. #module_, inst ^. #parentVars) @@ -1012,7 +1014,7 @@ origin = origin, moduleVersion = m ^. #version, appliedAt = now, - removal = m ^. #removal + removal = settleRemovalConditions (Map.map (^. #value) (resolved Map.! inst)) <$> m ^. #removal } | (inst, m, origin) <- modulesInOrder ] diff --git a/src/Seihou/CLI/ManifestCapabilityUpgrade.hs b/src/Seihou/CLI/ManifestCapabilityUpgrade.hs --- a/src/Seihou/CLI/ManifestCapabilityUpgrade.hs +++ b/src/Seihou/CLI/ManifestCapabilityUpgrade.hs @@ -31,6 +31,7 @@ prepareSeedOwnership, prepareRecordedSeedOwnership, prepareRecipeInheritance, + prepareRemovalPolicies, gatherSeedOwnershipEvidence, CertificationScope (..), EvidencePolicy (..), @@ -539,5 +540,13 @@ prepareRecipeInheritance manifest = do (_, document) <- first renderManifestUpgradeError $ - upgradeDocumentLosslessly (max (manifest ^. #version) (minimumManifestVersion RecipeInheritance)) (Aeson.toJSON manifest) + upgradeDocumentLosslessly (max (manifest ^. #version) (max (minimumManifestVersion RecipeInheritance) (minimumManifestVersion ConditionalRemovalPolicies))) (Aeson.toJSON manifest) + first T.pack (manifestFromJSON (Aeson.encode document)) + +-- | Stage the lossless policy boundary; dry-run callers never publish this candidate. +prepareRemovalPolicies :: Manifest -> Either Text Manifest +prepareRemovalPolicies manifest = do + (_, document) <- + first renderManifestUpgradeError $ + upgradeDocumentLosslessly (max (manifest ^. #version) (minimumManifestVersion ConditionalRemovalPolicies)) (Aeson.toJSON manifest) first T.pack (manifestFromJSON (Aeson.encode document)) diff --git a/src/Seihou/CLI/SchemaVersion.hs b/src/Seihou/CLI/SchemaVersion.hs --- a/src/Seihou/CLI/SchemaVersion.hs +++ b/src/Seihou/CLI/SchemaVersion.hs @@ -9,11 +9,11 @@ -- | Raw URL for the seihou-schema package.dhall at a pinned commit schemaUrl :: Text -schemaUrl = "https://raw.githubusercontent.com/shinzui/seihou-schema/dbeff0dd67c15b7a1c57f90b23103afdc2fa8056/package.dhall" +schemaUrl = "https://raw.githubusercontent.com/shinzui/seihou-schema/e9f91438f081fba90f40f987de93df9f74c7117d/package.dhall" -- | SHA256 integrity hash for the schema import schemaHash :: Text -schemaHash = "sha256:065c27b4d26059a7641e8ee7ee9d23ed32a698052c6aa8966426e6a678ee0e82" +schemaHash = "sha256:00f822087302b53f7ffe74e6505a633c59a0c2f206d12bfadb58a2fe211c0e40" -- | Complete Dhall import line for use in generated modules schemaImportLine :: Text diff --git a/src/Seihou/CLI/Update.hs b/src/Seihou/CLI/Update.hs --- a/src/Seihou/CLI/Update.hs +++ b/src/Seihou/CLI/Update.hs @@ -65,6 +65,7 @@ import Seihou.Core.ArtifactRef (renderArtifactRefError, resolveArtifactOrigin) import Seihou.Core.Checkout import Seihou.Core.CommandFingerprint (checkoutCommandsFromOperations) +import Seihou.Core.Expr (settleRemovalConditions) import Seihou.Core.Module (defaultSearchPaths, discoverRunnable) import Seihou.Core.Seed (seedApplicationIds) import Seihou.Core.Types @@ -164,7 +165,7 @@ selectedIdsForSeeds = Set.fromList (map (^. #candidate . #applicationId) plannedApplications) neededLegacy = Set.fromList [path | (path, receipt) <- Map.toAscList (base ^. #seeds), LegacySeedOwners apps <- [receipt ^. #ownership], Map.member path claims || not (Set.null (apps `Set.intersection` selectedIdsForSeeds))] relevant = not (Map.null claims) || any (\receipt -> not (Set.null (seedApplicationIds receipt `Set.intersection` selectedIdsForSeeds))) (Map.elems (base ^. #seeds)) - structurallyPrepared = prepareManifestSchema manifestPath RecipeInheritance document base >>= \prepared -> if relevant then prepareManifestSchema manifestPath SeedOwnerClaims (Aeson.toJSON prepared) prepared else Right prepared + structurallyPrepared = prepareManifestSchema manifestPath ConditionalRemovalPolicies document base >>= \prepared -> if relevant then prepareManifestSchema manifestPath SeedOwnerClaims (Aeson.toJSON prepared) prepared else Right prepared paths <- defaultSearchPaths preparedResult <- case structurallyPrepared of Left err -> pure (Left err) @@ -908,7 +909,8 @@ parentVars = state ^. #parentVars, origin = applied ^. #origin, moduleVersion = applied ^. #moduleVersion, - resolvedVars = state ^. #resolvedVars + resolvedVars = state ^. #resolvedVars, + removalPolicy = state ^. #removalPolicy } savedInstanceValues :: AppliedComposition -> SavedInstanceValues @@ -1313,7 +1315,7 @@ origin = publishedInstance application instanceId ^. #origin, moduleVersion = modul ^. #version, appliedAt = now, - removal = modul ^. #removal + removal = settleRemovalConditions (Map.map (^. #value) ((application ^. #resolvedValues) Map.! instanceId)) <$> modul ^. #removal } | (application, instanceId, modul) <- deduplicateInstances applications ] diff --git a/src/Seihou/CLI/Update/Render.hs b/src/Seihou/CLI/Update/Render.hs --- a/src/Seihou/CLI/Update/Render.hs +++ b/src/Seihou/CLI/Update/Render.hs @@ -50,6 +50,8 @@ ModuleLoadError (..), ModuleName (..), Operation (..), + ParentVars, + Removal, SHA256 (..), VarName (..), ) @@ -119,6 +121,9 @@ <> fromMaybe "" target <> "' to have an agent repair the manifest state and finish the upgrade.\n" +instancePolicies :: AppliedComposition -> [(ModuleName, ParentVars, Maybe Removal)] +instancePolicies application = [(state ^. #name, state ^. #parentVars, state ^. #removalPolicy) | state <- application ^. #instances] + renderUpdateHuman :: Bool -> UpdateOutput -> Text renderUpdateHuman _ (UpdatePlanOutput (UpdatePlanView plan)) = T.unlines $ @@ -132,6 +137,7 @@ renderFiles (reconciliationSummary (plan ^. #reconciliation)), if isUpdateNoOp plan then "Commands: 0 will run (no project update)" else renderCommands (summarizeCommandPlan (plan ^. #commandPlan)) ] + <> ["Removal policies changed: " <> appliedTargetName (application ^. #candidate . #target) | application <- plan ^. #plannedApplications, maybe [] instancePolicies (application ^. #previous) /= instancePolicies (application ^. #candidate)] <> ["Checkout declarations changed: " <> application ^. #candidate . #applicationId . #unApplicationId | application <- plan ^. #plannedApplications, maybe [] (^. #checkoutCommands) (application ^. #previous) /= application ^. #candidate . #checkoutCommands] <> [" checkout " <> (if isUpdateNoOp plan then "not-run-no-update" else dispositionText (command ^. #disposition)) <> ": " <> fromMaybe "" (commandText (command ^. #operation)) | command <- plan ^. #commandPlan . #commands, isCheckoutCommand (command ^. #operation)] <> T.lines (renderCheckoutPlan True (plan ^. #checkoutPlan)) diff --git a/src/Seihou/CLI/Update/Types.hs b/src/Seihou/CLI/Update/Types.hs --- a/src/Seihou/CLI/Update/Types.hs +++ b/src/Seihou/CLI/Update/Types.hs @@ -365,3 +365,4 @@ && previous ^. #origin == candidate ^. #origin && previous ^. #moduleVersion == candidate ^. #moduleVersion && previous ^. #resolvedVars == candidate ^. #resolvedVars + && previous ^. #removalPolicy == candidate ^. #removalPolicy diff --git a/test/Seihou/CLI/ManifestCapabilityUpgradeSpec.hs b/test/Seihou/CLI/ManifestCapabilityUpgradeSpec.hs --- a/test/Seihou/CLI/ManifestCapabilityUpgradeSpec.hs +++ b/test/Seihou/CLI/ManifestCapabilityUpgradeSpec.hs @@ -114,7 +114,7 @@ spec :: Spec spec = do describe "legacy seed ownership evidence" $ do - let instanceState name = AppliedInstanceState name emptyParentVars (LocalOrigin (name ^. #unModuleName)) (Just "1.0.0") Map.empty + let instanceState name = AppliedInstanceState name emptyParentVars (LocalOrigin (name ^. #unModuleName)) (Just "1.0.0") Map.empty Nothing app = recordedApplication appA & #instances .~ map instanceState ["first", "second"] receipt = SeedRecord "first" (LegacySeedOwners (Set.singleton appA)) SeedCreated testTime old = emptyManifest testTime & #applications .~ [app] & #seeds .~ Map.singleton "a.txt" receipt @@ -294,7 +294,7 @@ case manifestFromJSON written of Left err -> expectationFailure err Right upgraded -> do - (upgraded ^. #version) `shouldBe` ManifestSchemaVersion 13 + (upgraded ^. #version) `shouldBe` ManifestSchemaVersion 14 (^. #sharedWriteMode) <$> Map.lookup ".gitignore" (upgraded ^. #files) `shouldBe` Just SharedWriteAdditiveOnly TIO.readFile (fixture ^. #gitignorePath) `shouldReturn` gitignoreBefore diff --git a/test/Seihou/CLI/ManifestRepairOriginsSpec.hs b/test/Seihou/CLI/ManifestRepairOriginsSpec.hs --- a/test/Seihou/CLI/ManifestRepairOriginsSpec.hs +++ b/test/Seihou/CLI/ManifestRepairOriginsSpec.hs @@ -56,7 +56,7 @@ additionalModules = [], namespace = Nothing, context = Nothing, - instances = [AppliedInstanceState "beta" emptyParentVars (origin localPath "beta") (Just "1.0.0") Map.empty], + instances = [AppliedInstanceState "beta" emptyParentVars (origin localPath "beta") (Just "1.0.0") Map.empty Nothing], commandReceipts = Map.empty, checkoutCommands = [], recipeInputs = Nothing, diff --git a/test/Seihou/CLI/ManifestUpgradeSpec.hs b/test/Seihou/CLI/ManifestUpgradeSpec.hs --- a/test/Seihou/CLI/ManifestUpgradeSpec.hs +++ b/test/Seihou/CLI/ManifestUpgradeSpec.hs @@ -264,12 +264,12 @@ outcome <- runManifestUpgrade (opts False False Nothing) case outcome of UpgradeWritten result -> do - map stepVersions (result ^. #steps) `shouldBe` [(6, 7), (7, 8), (8, 9), (9, 10), (10, 11), (11, 12), (12, 13)] + map stepVersions (result ^. #steps) `shouldBe` [(6, 7), (7, 8), (8, 9), (9, 10), (10, 11), (11, 12), (12, 13), (13, 14)] (result ^. #entries) `shouldBe` [] - (result ^. #toVersion) `shouldBe` ManifestSchemaVersion 13 + (result ^. #toVersion) `shouldBe` ManifestSchemaVersion 14 other -> expectationFailure ("expected a write, got " <> show other) document <- readDocument manifestPath - lookupPath ["version"] document `shouldBe` Just (Aeson.Number 13) + lookupPath ["version"] document `shouldBe` Just (Aeson.Number 14) lookupPath ["files", ".gitignore", "sharedWriteMode"] document `shouldBe` Just (Aeson.String "additive-only") lookupPath ["files", "README.md", "sharedWriteMode"] document `shouldBe` Just (Aeson.String "unknown") lookupPath ["files", ".gitignore", "additiveOnly"] document `shouldBe` Nothing @@ -281,7 +281,7 @@ before <- LBS.readFile manifestPath outcome <- runManifestUpgrade (opts False False Nothing) case outcome of - UpgradeNotNeeded version _ -> version `shouldBe` ManifestSchemaVersion 13 + UpgradeNotNeeded version _ -> version `shouldBe` ManifestSchemaVersion 14 other -> expectationFailure ("expected nothing to do, got " <> show other) LBS.readFile manifestPath `shouldReturn` before @@ -310,7 +310,7 @@ outcome <- runManifestUpgrade (opts True True Nothing) case outcome of UpgradeWouldWrite result [] -> do - map stepVersions (result ^. #steps) `shouldBe` [(5, 6), (6, 7), (7, 8), (8, 9), (9, 10), (10, 11), (11, 12), (12, 13)] + map stepVersions (result ^. #steps) `shouldBe` [(5, 6), (6, 7), (7, 8), (8, 9), (9, 10), (10, 11), (11, 12), (12, 13), (13, 14)] map (^. #artifactName) (result ^. #entries) `shouldBe` ["haskell-base", "project-lint", "haskell-service", "scratch-helper"] let report = formatUpgradeReport result @@ -335,10 +335,10 @@ outcome <- runManifestUpgrade (opts False True Nothing) case outcome of UpgradeWritten result -> - map stepVersions (result ^. #steps) `shouldBe` [(2, 3), (3, 4), (4, 5), (5, 6), (6, 7), (7, 8), (8, 9), (9, 10), (10, 11), (11, 12), (12, 13)] + map stepVersions (result ^. #steps) `shouldBe` [(2, 3), (3, 4), (4, 5), (5, 6), (6, 7), (7, 8), (8, 9), (9, 10), (10, 11), (11, 12), (12, 13), (13, 14)] other -> expectationFailure ("expected a write, got " <> show other) document <- readDocument manifestPath - lookupPath ["version"] document `shouldBe` Just (Aeson.Number 13) + lookupPath ["version"] document `shouldBe` Just (Aeson.Number 14) it "rejects a target newer than this build or older than the document" $ do withUpgradeProject schema6Manifest $ \_ -> @@ -366,7 +366,7 @@ output `shouldSatisfy` T.isInfixOf "5 -> 6" output `shouldSatisfy` T.isInfixOf "6 -> 7" document <- readDocument manifestPath - lookupPath ["version"] document `shouldBe` Just (Aeson.Number 13) + lookupPath ["version"] document `shouldBe` Just (Aeson.Number 14) lookupPath ["modules", "0", "origin"] document `shouldBe` Just (Aeson.toJSON (RemoteOrigin "https://example.com/demo-modules.git" "demo" (Just "demo-modules"))) filter absoluteLooking (documentStrings document) `shouldBe` [] diff --git a/test/Seihou/CLI/RecipeExtensionE2ESpec.hs b/test/Seihou/CLI/RecipeExtensionE2ESpec.hs --- a/test/Seihou/CLI/RecipeExtensionE2ESpec.hs +++ b/test/Seihou/CLI/RecipeExtensionE2ESpec.hs @@ -77,7 +77,7 @@ before <- readManifest root case Aeson.eitherDecode before :: Either String Aeson.Value of Right (Aeson.Object fields) -> do - KM.lookup "version" fields `shouldBe` Just (Aeson.toJSON (13 :: Int)) + KM.lookup "version" fields `shouldBe` Just (Aeson.toJSON (14 :: Int)) T.pack (show fields) `shouldSatisfy` T.isInfixOf "recipeChain" T.pack (show fields) `shouldSatisfy` T.isInfixOf "descriptorHash" other -> expectationFailure (show other) diff --git a/test/Seihou/CLI/SeedRunE2ESpec.hs b/test/Seihou/CLI/SeedRunE2ESpec.hs --- a/test/Seihou/CLI/SeedRunE2ESpec.hs +++ b/test/Seihou/CLI/SeedRunE2ESpec.hs @@ -204,3 +204,26 @@ D.removeFile (root "nested/start.txt") _ <- success binary root ["run", "demo"] TIO.readFile (root "nested/start.txt") `shouldReturn` "starter\n" + + it "removes a recorded seed root and its unshared inherited managed files in one command" $ + withSystemTempDirectory "seed-root-closure" $ \root -> do + (binary, modul) <- prepare root + let base = root ".seihou/modules/base" + D.createDirectoryIfMissing True (base "files") + TIO.writeFile (base "files/base") "managed base\n" + TIO.writeFile (base "files/starter") "wrong base starter\n" + TIO.writeFile (base "module.dhall") "let S = ../demo/schema/package.dhall in S.Module::{name=\"base\",version=Some \"1.0.0\",vars=[S.VarDecl::{name=\"base.starters\",type=\"bool\",default=Some \"true\"}],steps=[S.Step::{strategy=\"copy\",src=\"base\",dest=\"base.txt\"},S.Step::{strategy=\"copy\",src=\"starter\",dest=\"nested/start.txt\",when=Some \"Eq base.starters true\"}],removal=Some S.Removal::{steps=[S.RemovalStep::{action=\"remove-file\",dest=\"base.txt\"},S.RemovalStep::{action=\"remove-file\",dest=\"nested/start.txt\",when=Some \"Eq base.starters true\"}]}}" + TIO.writeFile (modul "module.dhall") (body "seed" ",dependencies=[S.Dependency::{module=\"base\",vars=[{name=\"base.starters\",value=\"false\"}]}],removal=Some S.Removal::{steps=[S.RemovalStep::{action=\"remove-file\",dest=\"LICENSE\"}]}") + _ <- success binary root ["run", "demo"] + TIO.writeFile (root "nested/start.txt") "authored seed\n" + before <- BS.readFile (root ".seihou/manifest.json") + preview <- success binary root ["remove", "demo", "--dry-run"] + preview `shouldSatisfy` T.isInfixOf "Retire inherited module base" + BS.readFile (root ".seihou/manifest.json") `shouldReturn` before + _ <- success binary root ["remove", "demo"] + TIO.readFile (root "nested/start.txt") `shouldReturn` "authored seed\n" + D.doesFileExist (root "base.txt") `shouldReturn` False + D.doesFileExist (root "LICENSE") `shouldReturn` False + after <- readManifest root + after ^. #applications `shouldBe` [] + after ^. #modules `shouldBe` [] diff --git a/test/Seihou/CLI/StatusSpec.hs b/test/Seihou/CLI/StatusSpec.hs --- a/test/Seihou/CLI/StatusSpec.hs +++ b/test/Seihou/CLI/StatusSpec.hs @@ -101,7 +101,8 @@ parentVars = emptyParentVars, origin = LocalOrigin name, moduleVersion = Just "1.0.0", - resolvedVars = Map.empty + resolvedVars = Map.empty, + removalPolicy = Nothing } -- | Build a 'MigrationPlan' fixture for use with formatStatus. diff --git a/test/Seihou/CLI/UpdateE2ESpec.hs b/test/Seihou/CLI/UpdateE2ESpec.hs --- a/test/Seihou/CLI/UpdateE2ESpec.hs +++ b/test/Seihou/CLI/UpdateE2ESpec.hs @@ -237,7 +237,7 @@ expectSuccess "targeted update" exitCode stdoutText stderrText stdoutText `shouldSatisfy` T.isInfixOf "\"outcome\":\"applied\"" manifestText <- TIO.readFile (fixture ^. #manifestPath) - manifestText `shouldSatisfy` T.isInfixOf "\"version\":13" + manifestText `shouldSatisfy` T.isInfixOf "\"version\":14" manifestText `shouldSatisfy` T.isInfixOf "\"sharedWriteMode\":\"additive-only\"" -- Recording an answer must not touch a single byte of the project. TIO.readFile (fixture ^. #gitignorePath) `shouldReturn` beforeGitignore @@ -276,7 +276,7 @@ dryOut `shouldSatisfy` T.isInfixOf "\"outcome\":\"plan\"" dryOut `shouldSatisfy` T.isInfixOf "\"alreadyUpToDate\":false" dryOut `shouldSatisfy` T.isInfixOf "\"fromSchema\":6" - dryOut `shouldSatisfy` T.isInfixOf "\"toSchema\":13" + dryOut `shouldSatisfy` T.isInfixOf "\"toSchema\":14" dryOut `shouldSatisfy` T.isInfixOf "{\"from\":\"unknown\",\"path\":\".gitignore\",\"to\":\"additive-only\"}" dryOut `shouldNotSatisfy` T.isInfixOf "shared_path_requires_applications" LBS.readFile (fixture ^. #manifestPath) `shouldReturn` beforeManifest @@ -297,7 +297,7 @@ case decoded of Left err -> expectationFailure err Right manifest -> do - (manifest ^. #version) `shouldBe` ManifestSchemaVersion 13 + (manifest ^. #version) `shouldBe` ManifestSchemaVersion 14 case Map.lookup ".gitignore" (manifest ^. #files) of Nothing -> expectationFailure "the manifest lost .gitignore" Just record -> do @@ -317,7 +317,7 @@ binary <- seihouBinary (dryExit, dryOut, dryErr) <- runSeihouShared binary bug1 ["update", "alpha", "--dry-run"] expectSuccess "human dry run" dryExit dryOut dryErr - dryOut `shouldSatisfy` T.isInfixOf "Manifest: schema 6 -> 13" + dryOut `shouldSatisfy` T.isInfixOf "Manifest: schema 6 -> 14" dryOut `shouldSatisfy` T.isInfixOf ".gitignore evidence unknown -> additive-only" (dryOut <> dryErr) `shouldNotSatisfy` leaksInternals diff --git a/test/Seihou/CLI/UpdateSpec.hs b/test/Seihou/CLI/UpdateSpec.hs --- a/test/Seihou/CLI/UpdateSpec.hs +++ b/test/Seihou/CLI/UpdateSpec.hs @@ -12,7 +12,7 @@ where import Control.Exception (bracket) -import Control.Lens ((&), (.~), (^.)) +import Control.Lens ((%~), (&), (.~), (^.)) import Control.Monad (forM_) import Data.ByteString.Lazy qualified as LBS import Data.Foldable (traverse_) @@ -372,6 +372,15 @@ isUpdateNoOp (unchangedFilePlan SharedWriteAdditiveOnly True) `shouldBe` True isUpdateNoOp (unchangedFilePlan SharedWriteRequiresOwnershipClosure False) `shouldBe` True + it "accepts removal-policy-only adoption and then returns to a true no-op" $ do + let previous = application (AppliedModuleTarget "base") [instanceState "base"] + policy = Removal [RemovalStep RemoveFileAction "starter" Nothing (Just (ExprLit False))] [] + candidate = previous & #instances %~ map (\state -> state & #removalPolicy .~ Just policy) + planned before after = PlannedApplication (Just before) after [] Map.empty [] Map.empty + plan before after = unchangedFilePlan SharedWriteAdditiveOnly True & #plannedApplications .~ [planned before after] & #applications .~ [after] + isUpdateNoOp (plan previous candidate) `shouldBe` False + isUpdateNoOp (plan candidate candidate) `shouldBe` True + it "rejects a plan when its manifest snapshot changes" $ withSystemTempDirectory "seihou-update-stale" $ \root -> do fixture <- prepareUpdateFixture root @@ -584,7 +593,7 @@ withSystemTempDirectory "seihou-update-schema-5" $ \root -> do fixture <- prepareSharedPathFixture CoOwnerAppends root manifestText <- TIO.readFile (fixture ^. #manifestPath) - TIO.writeFile (fixture ^. #manifestPath) (T.replace "\"version\":13" "\"version\":5" manifestText) + TIO.writeFile (fixture ^. #manifestPath) (T.replace "\"version\":14" "\"version\":5" manifestText) withSavedEnv "XDG_CONFIG_HOME" (Just (fixture ^. #xdgHome)) $ withCurrentDirectory (fixture ^. #projectRoot) $ do forM_ [NamedUpdateTargets ["alpha"], AllRecordedApplications] $ \selection -> do @@ -617,7 +626,7 @@ parentTwo = ParentVars (Map.singleton "tenant" "two") instanceOne = ModuleInstance "shared" parentOne instanceTwo = ModuleInstance "shared" parentTwo - stateFor parent = AppliedInstanceState "shared" parent (LocalOrigin "shared") (Just "1.0.0") Map.empty + stateFor parent = AppliedInstanceState "shared" parent (LocalOrigin "shared") (Just "1.0.0") Map.empty Nothing previous = application (AppliedModuleTarget "shared") [stateFor parentOne, stateFor parentTwo] candidate = Module @@ -1195,7 +1204,8 @@ parentVars = emptyParentVars, origin, moduleVersion = Just "1.0.0", - resolvedVars = Map.empty + resolvedVars = Map.empty, + removalPolicy = Nothing } moduleDhall :: Text -> Text -> Text diff --git a/test/Seihou/CLI/UpgradeDiagnosisSpec.hs b/test/Seihou/CLI/UpgradeDiagnosisSpec.hs --- a/test/Seihou/CLI/UpgradeDiagnosisSpec.hs +++ b/test/Seihou/CLI/UpgradeDiagnosisSpec.hs @@ -43,7 +43,7 @@ withFixture CoOwnerAppendsPredatingEvidence noDamage $ \_ _ diagnose -> do checks <- readiness <$> diagnose "alpha" statusOf "manifest-schema-current" checks `shouldBe` NeedsAttention - detailOf "manifest-schema-current" checks `shouldSatisfy` T.isInfixOf "schema 6 is older than 13" + detailOf "manifest-schema-current" checks `shouldSatisfy` T.isInfixOf "schema 6 is older than 14" statusOf "shared-evidence-known" checks `shouldBe` NeedsAttention detailOf "shared-evidence-known" checks `shouldBe` ".gitignore is shared with beta and its write mode is unknown" statusOf "update-plans-cleanly" checks `shouldBe` Ready @@ -59,7 +59,7 @@ ((^. #errorCode) <$> diagnosis ^. #updateDryRun) `shouldBe` ProbeOk (Just "shared_write_evidence_unavailable") it "reports a schema-5 manifest as needing seihou manifest upgrade" $ - withFixture CoOwnerAppends (withManifestText (T.replace "\"version\":13" "\"version\":5")) $ \_ _ diagnose -> do + withFixture CoOwnerAppends (withManifestText (T.replace "\"version\":14" "\"version\":5")) $ \_ _ diagnose -> do diagnosis <- diagnose "alpha" let checks = readiness diagnosis statusOf "manifest-readable" checks `shouldBe` NeedsAttention @@ -154,7 +154,7 @@ [ ("healthy" :: Text, CoOwnerAppends, const (pure ())), ("schema 6", CoOwnerAppendsPredatingEvidence, const (pure ())), ("evidence unavailable", CoOwnerAppendsPredatingEvidence, evidenceUnavailable), - ("schema 5", CoOwnerAppends, withManifestText (T.replace "\"version\":13" "\"version\":5")), + ("schema 5", CoOwnerAppends, withManifestText (T.replace "\"version\":14" "\"version\":5")), ("not json", CoOwnerAppends, withManifestText (const "{not json")), ("local origin", CoOwnerAppends, localBetaOrigin), ("pending transaction", CoOwnerAppends, pendingTransaction)