seihou-core 0.14.0.0 → 0.15.0.0

raw patch · 15 files changed

+354/−94 lines, 15 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• seihou-core.cabal +1/−1
• src/Seihou/Core/Application.hs +3/−1
• src/Seihou/Core/Expr.hs +7/−0
• src/Seihou/Core/Types.hs +5/−2
• src/Seihou/Dhall/Eval.hs +9/−6
• src/Seihou/Engine/Remove.hs +78/−43
• src/Seihou/Manifest/Types.hs +47/−16
• src/Seihou/Manifest/Upgrade.hs +65/−2
• test/Seihou/Core/ApplicationSpec.hs +12/−1
• test/Seihou/Core/SeedSpec.hs +2/−2
• test/Seihou/Engine/CheckoutSpec.hs +1/−1
• test/Seihou/Engine/RemoveSpec.hs +66/−12
• test/Seihou/Engine/SeedTransactionSpec.hs +1/−1
• test/Seihou/Manifest/TypesSpec.hs +42/−6
• test/Seihou/Manifest/UpgradeSpec.hs +15/−0

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

@@ -15,6 +15,7 @@ import Data.Text qualified as T import Data.Time (UTCTime) import Seihou.Composition.Instance (ModuleInstance (..))+import Seihou.Core.Expr (settleRemovalConditions) import Seihou.Core.Types import Seihou.Manifest.Hash (hashContent) @@ -77,7 +78,8 @@           parentVars = inst ^. #parentVars,           origin = origin,           moduleVersion = modul ^. #version,-          resolvedVars = Map.map (varValueToText . (^. #value)) (Map.findWithDefault Map.empty inst resolved)+          resolvedVars = Map.map (varValueToText . (^. #value)) (Map.findWithDefault Map.empty inst resolved),+          removalPolicy = settleRemovalConditions (Map.map (^. #value) (Map.findWithDefault Map.empty inst resolved)) <$> modul ^. #removal         }  -- | Replace an existing application in place, or append a newly-applied one.

@@ -2,11 +2,13 @@   ( parseExpr,     renderExpr,     evalExpr,+    settleRemovalConditions,     exprRefs,   ) where  import Data.Char (isDigit)+import Data.Generics.Labels () import Data.Map.Strict qualified as Map import Data.Text qualified as T import Seihou.Core.Types@@ -97,6 +99,11 @@     go (ExprNot e) = not (go e)     go (ExprIsSet name) = Map.member name vars     go (ExprLit b) = b++-- | Capture the policy while resolved values still retain their declared types.+-- Persist literals, never reinterpret flattened text during a later removal.+settleRemovalConditions :: Map VarName VarValue -> Removal -> Removal+settleRemovalConditions variables spec = spec & #steps %~ map (\step -> step & #condition %~ fmap (ExprLit . evalExpr variables))  -- | Collect the variables an expression references, paired with the literal -- each is compared against via 'Eq' (if any).

@@ -301,7 +301,8 @@ data RemovalStep = RemovalStep   { action :: !RemovalAction,     dest :: !Text,-    src :: !(Maybe FilePath)+    src :: !(Maybe FilePath),+    condition :: !(Maybe Expr)   }   deriving stock (Eq, Show, Generic) @@ -630,6 +631,7 @@   | SeedReceipts   | RecipeInputs   | RecipeInheritance+  | ConditionalRemovalPolicies   | SeedOwnerClaims   | CheckoutLocalOutputs   | CheckoutLocalCommands@@ -768,7 +770,8 @@     parentVars :: !ParentVars,     origin :: !ArtifactOrigin,     moduleVersion :: !(Maybe Text),-    resolvedVars :: !(Map VarName Text)+    resolvedVars :: !(Map VarName Text),+    removalPolicy :: !(Maybe Removal)   }   deriving stock (Eq, Show, Generic) 

@@ -104,6 +104,7 @@         mapM_ (\v -> evaluate (v ^. #type_)) (m ^. #vars)         mapM_ (\s -> evaluate (s ^. #lifecycle) >> evaluate (s ^. #strategy) >> evaluate (s ^. #condition) >> mapM_ evaluate (s ^. #patch)) (m ^. #steps)         mapM_ (\c -> evaluate (c ^. #lifecycle) >> mapM_ evaluate (c ^. #condition)) ((m ^. #commands) <> concatMap (^. #commands) (m ^. #removal))+        mapM_ (\s -> evaluate (s ^. #condition)) (concatMap (^. #steps) (m ^. #removal))         mapM_ (\p -> evaluate (p ^. #condition)) (m ^. #prompts)         pure m       Failure e -> throwIO e@@ -514,12 +515,14 @@ -- | Decoder for RemovalStep from a Dhall record. removalStepDecoder :: Decoder RemovalStep removalStepDecoder =-  record-    ( RemovalStep-        <$> field "action" removalActionDecoder-        <*> field "dest" strictText-        <*> field "src" (maybe string)-    )+  withDefaults [("when", noneText)] $+    record+      ( RemovalStep+          <$> field "action" removalActionDecoder+          <*> field "dest" strictText+          <*> field "src" (maybe string)+          <*> (parseWhen <$> field "when" (maybe strictText))+      )  -- | Decoder for RemovalAction from a Dhall Text string. --

@@ -10,16 +10,17 @@     selectRecordedRemoval,     computeRemovalPlan,     executeRemoval,+    settleRemovalConditions,     buildRemovalOps,     executeRemovalOps,   ) where -import Control.Monad (foldM)+import Control.Monad (foldM, forM_, unless, when) import Data.Generics.Labels () import Data.List (nub, sortBy) import Data.Map.Strict qualified as Map-import Data.Maybe (listToMaybe, mapMaybe, maybeToList)+import Data.Maybe (isJust, isNothing, listToMaybe, mapMaybe, maybeToList) import Data.Ord (Down (..)) import Data.Set (Set) import Data.Set qualified as Set@@ -27,6 +28,7 @@ import Data.Time (UTCTime) import Seihou.Composition.Instance (ModuleInstance (..), qualifiedName) import Seihou.Core.Checkout+import Seihou.Core.Expr (settleRemovalConditions) import Seihou.Core.Path (pathsHaveConflictingSpelling, validateProjectRelativePath) import Seihou.Core.Seed import Seihou.Core.Types@@ -146,6 +148,17 @@ -- New step-based removal engine -- ============================================================ +settledCondition :: RemovalStep -> Bool+settledCondition step = case step ^. #condition of+  Nothing -> True+  Just (ExprLit _) -> True+  _ -> False++enabledStep :: RemovalStep -> Bool+enabledStep step = case step ^. #condition of+  Just (ExprLit False) -> False+  _ -> True+ -- | Build a list of removal operations from declared removal steps. -- Classifies remove-file targets by checking the manifest and disk state. buildRemovalOps ::@@ -157,8 +170,10 @@ buildRemovalOps manifest modName removal = do   case findApplied manifest modName of     Nothing -> pure (Left (ModuleNotApplied modName))+    Just _ | any (not . settledCondition) (removal ^. #steps) -> pure (Left (RemovalUnsafePath "condition" "when" "unsettled removal policy; run an ordinary update with this runtime first"))     Just _ -> do-      stepResults <- mapM (buildStepOp manifest modName) (removal ^. #steps)+      let active = filter enabledStep (removal ^. #steps)+      stepResults <- mapM (buildStepOp manifest modName) active       let cmdResults = map buildCommandOp (removal ^. #commands)       pure $ do         stepOps <- sequence stepResults@@ -408,46 +423,66 @@  -- | Shared selection for seed, checkout-output and checkout-command ownership. selectRecordedRemoval :: Manifest -> ModuleName -> Maybe ApplicationId -> Either CheckoutError (Maybe CheckoutRemovalSelection)-selectRecordedRemoval manifest requested selectedApplication = case candidates of-  []-    | selectedApplication /= Nothing -> Left (checkoutError "checkout_remove_selection" "no matching recorded owning instance in the selected application")-    | otherwise -> Right Nothing-  [(app, state, qualified)] -> do-    let appId = app ^. #applicationId-        selected = Map.singleton appId (Set.singleton qualified)-        outputs = dropCheckoutOwners selected (manifest ^. #checkoutOutputs)-        keepFile record-          | record ^. #moduleName /= qualified || not (Set.member appId (record ^. #applicationIds)) = Just record-          | otherwise =-              let retained = Set.delete appId (record ^. #applicationIds)-               in if Set.null retained then Nothing else Just (record & #applicationIds .~ retained)-        keepApplication other-          | other ^. #applicationId /= appId = Just other-          | otherwise =-              let retained = filter (\instanceState -> qualifiedName (ModuleInstance (instanceState ^. #name) (instanceState ^. #parentVars)) /= qualified) (other ^. #instances)-               in if null retained then Nothing else Just (other & #instances .~ retained & #commandReceipts %~ Map.filter ((/= qualified) . (^. #moduleName)) & #checkoutCommands %~ filter ((/= qualified) . (^. #moduleName)))-        applications = mapMaybe keepApplication (manifest ^. #applications)-        files = Map.mapMaybe keepFile (manifest ^. #files)-        stillNeeded applied =-          any (\other -> any (\instanceState -> instanceState ^. #name == applied ^. #name && instanceState ^. #parentVars == applied ^. #parentVars) (other ^. #instances)) applications-            || any ((== qualifiedName (ModuleInstance (applied ^. #name) (applied ^. #parentVars))) . (^. #moduleName)) (Map.elems files)-        removeSelected applied = applied ^. #name /= state ^. #name || applied ^. #parentVars /= state ^. #parentVars || stillNeeded applied-        candidate = manifest & #checkoutOutputs .~ outputs & #applications .~ applications & #files .~ files & #modules %~ filter removeSelected-        custom = listToMaybe [spec | applied <- manifest ^. #modules, applied ^. #name == state ^. #name, applied ^. #parentVars == state ^. #parentVars, spec <- maybeToList (applied ^. #removal)]-    -- Retiring seed-only metadata does not authorize forgetting managed files.-    case custom of-      Nothing-        | any (\record -> record ^. #moduleName == qualified && Set.member appId (record ^. #applicationIds)) (Map.elems (manifest ^. #files)) ->-            Left (checkoutError "remove_managed_policy_required" "this instance also owns managed files; add a removal specification for those files before removing it")-      _ -> Right ()-    withSeeds <--      first (checkoutError "seed_owner_evidence_required" . renderSeedOwnershipError) $-        foldM (\current path -> dropSeedOwners selected path current) candidate (Map.keys (manifest ^. #seeds))-    first (checkoutError "seed_declaration_invalid" . renderManifestInvariantError) (validateManifestInvariants withSeeds)-    validateCheckoutRecords withSeeds []-    pure (Just (CheckoutRemovalSelection appId qualified (state ^. #name) custom withSeeds))-  matches -> Left (checkoutError "checkout_remove_ambiguous" ("recorded removal is ambiguous; select one recorded instance/application: " <> T.intercalate "; " ["seihou remove " <> qualified ^. #unModuleName <> " --application " <> app ^. #applicationId . #unApplicationId | (app, _, qualified) <- matches]))+selectRecordedRemoval manifest requested selectedApplication = do+  case candidates of+    []+      | selectedApplication /= Nothing -> Left (checkoutError "checkout_remove_selection" "no matching recorded owning instance in the selected application")+      | otherwise -> Right Nothing+    [(app, state, qualified)] -> do+      let appId = app ^. #applicationId+          rootRemoval = app ^. #target == AppliedModuleTarget (state ^. #name) && null (app ^. #additionalModules)+          departing = if rootRemoval then Set.fromList [qualifiedName (ModuleInstance (instanceState ^. #name) (instanceState ^. #parentVars)) | instanceState <- app ^. #instances] else Set.singleton qualified+          selected = Map.singleton appId departing+          outputs = dropCheckoutOwners selected (manifest ^. #checkoutOutputs)+          keepFile record+            | not (Set.member (record ^. #moduleName) departing) || not (Set.member appId (record ^. #applicationIds)) = Just record+            | otherwise =+                let retained = Set.delete appId (record ^. #applicationIds)+                 in if Set.null retained then Nothing else Just (record & #applicationIds .~ retained)+          keepApplication other+            | other ^. #applicationId /= appId = Just other+            | otherwise =+                let retained = filter (\instanceState -> not (Set.member (qualifiedName (ModuleInstance (instanceState ^. #name) (instanceState ^. #parentVars))) departing)) (other ^. #instances)+                 in if null retained then Nothing else Just (other & #instances .~ retained & #commandReceipts %~ Map.filter (not . (`Set.member` departing) . (^. #moduleName)) & #checkoutCommands %~ filter (not . (`Set.member` departing) . (^. #moduleName)))+          applications = mapMaybe keepApplication (manifest ^. #applications)+          files = Map.mapMaybe keepFile (manifest ^. #files)+          stillNeeded applied =+            any (\other -> any (\instanceState -> instanceState ^. #name == applied ^. #name && instanceState ^. #parentVars == applied ^. #parentVars) (other ^. #instances)) applications+              || any ((== qualifiedName (ModuleInstance (applied ^. #name) (applied ^. #parentVars))) . (^. #moduleName)) (Map.elems files)+          removeSelected applied = not (Set.member (qualifiedName (ModuleInstance (applied ^. #name) (applied ^. #parentVars))) departing) || stillNeeded applied+          candidate = manifest & #checkoutOutputs .~ outputs & #applications .~ applications & #files .~ files & #modules %~ filter removeSelected+          -- The application records dependency order; a shared module summary+          -- can move when another root is run and is not an ordering authority.+          retiring = [applied | instanceState <- app ^. #instances, applied <- manifest ^. #modules, applied ^. #name == instanceState ^. #name, applied ^. #parentVars == instanceState ^. #parentVars, not (removeSelected applied)]+          stateFor applied = listToMaybe [instanceState | instanceState <- app ^. #instances, instanceState ^. #name == applied ^. #name, instanceState ^. #parentVars == applied ^. #parentVars]+          recordedSpec applied = case stateFor applied >>= (^. #removalPolicy) of+            Just spec -> Just spec+            Nothing -> applied ^. #removal+          settle spec = spec & #steps %~ map (\step -> step & #condition .~ Nothing) . filter enabledStep+          specs = [settle spec | applied <- reverse retiring, spec <- maybeToList (recordedSpec applied)]+          custom = if null specs then Nothing else Just (Removal (concatMap (^. #steps) specs) (concatMap (^. #commands) specs))+      forM_ retiring $ \applied -> do+        when (maybe True (isNothing . (^. #removalPolicy)) (stateFor applied) && any (any (isJust . (^. #condition)) . (^. #steps)) (applied ^. #removal)) $+          Left (checkoutError "removal_policy_unknown" "this application has no accepted conditional removal policy; run its ordinary update before removing it")+        unless (all (all settledCondition . (^. #steps)) (recordedSpec applied)) $+          Left (checkoutError "removal_policy_unsettled" "removal policy has no typed recorded result; run an ordinary update with this runtime first")+        when (recordedSpec applied == Nothing && any (\record -> record ^. #moduleName == qualifiedName (ModuleInstance (applied ^. #name) (applied ^. #parentVars)) && Set.member appId (record ^. #applicationIds)) (Map.elems (manifest ^. #files))) $+          Left (checkoutError "remove_managed_policy_required" "an inherited instance owns managed files without a removal specification; add its removal policy before removing this root")+      -- Retiring seed-only metadata does not authorize forgetting managed files.+      case custom of+        Nothing+          | any (\record -> Set.member (record ^. #moduleName) departing && Set.member appId (record ^. #applicationIds)) (Map.elems (manifest ^. #files)) ->+              Left (checkoutError "remove_managed_policy_required" "this instance also owns managed files; add a removal specification for those files before removing it")+        _ -> Right ()+      withSeeds <-+        first (checkoutError "seed_owner_evidence_required" . renderSeedOwnershipError) $+          foldM (\current path -> dropSeedOwners selected path current) candidate (Map.keys (manifest ^. #seeds))+      first (checkoutError "seed_declaration_invalid" . renderManifestInvariantError) (validateManifestInvariants withSeeds)+      validateCheckoutRecords withSeeds []+      pure (Just (CheckoutRemovalSelection appId qualified (state ^. #name) custom withSeeds))+    matches -> Left (checkoutError "checkout_remove_ambiguous" ("recorded removal is ambiguous; select one recorded instance/application: " <> T.intercalate "; " ["seihou remove " <> qualified ^. #unModuleName <> " --application " <> app ^. #applicationId . #unApplicationId | (app, _, qualified) <- matches]))   where+    hasConditionalPolicy state = any (any (isJust . (^. #condition)) . (^. #steps)) (state ^. #removalPolicy) || any (\applied -> applied ^. #name == state ^. #name && applied ^. #parentVars == state ^. #parentVars && any (any (isJust . (^. #condition)) . (^. #steps)) (applied ^. #removal)) (manifest ^. #modules)     candidates =       [ (app, state, qualified)       | app <- manifest ^. #applications,@@ -455,5 +490,5 @@         state <- app ^. #instances,         let qualified = qualifiedName (ModuleInstance (state ^. #name) (state ^. #parentVars)),         requested == qualified || requested == state ^. #name,-        any (\record -> case record ^. #ownership of KnownSeedOwners owners -> Set.member qualified (Map.findWithDefault Set.empty (app ^. #applicationId) owners); LegacySeedOwners apps -> Set.member (app ^. #applicationId) apps) (Map.elems (manifest ^. #seeds)) || any ((== qualified) . (^. #moduleName)) (app ^. #checkoutCommands) || any (\record -> Set.member qualified (Map.findWithDefault Set.empty (app ^. #applicationId) (record ^. #owners))) (Map.elems (manifest ^. #checkoutOutputs))+        (app ^. #target == AppliedModuleTarget (state ^. #name) && null (app ^. #additionalModules)) || hasConditionalPolicy state || any (\record -> case record ^. #ownership of KnownSeedOwners owners -> Set.member qualified (Map.findWithDefault Set.empty (app ^. #applicationId) owners); LegacySeedOwners apps -> Set.member (app ^. #applicationId) apps) (Map.elems (manifest ^. #seeds)) || any ((== qualified) . (^. #moduleName)) (app ^. #checkoutCommands) || any (\record -> Set.member qualified (Map.findWithDefault Set.empty (app ^. #applicationId) (record ^. #owners))) (Map.elems (manifest ^. #checkoutOutputs))       ]

@@ -16,7 +16,7 @@   ) where -import Control.Monad (forM_, unless, when)+import Control.Monad (forM, forM_, unless, when) import Data.Aeson (FromJSON (..), ToJSON (..), (.:), (.=)) import Data.Aeson qualified as Aeson import Data.Aeson.Key qualified as Key@@ -34,6 +34,7 @@ import Seihou.Core.ArtifactIdentity (isMachineLocalOriginUrl, sameArtifactIdentity) import Seihou.Core.Checkout (CheckoutError (..), validateCheckoutRecords) import Seihou.Core.CommandFingerprint (checkoutCommandOperation, fingerprintCommand)+import Seihou.Core.Expr (renderExpr) import Seihou.Core.Module (isValidModuleName) import Seihou.Core.Path (validateCanonicalProjectPath, validateProjectRelativePath) import Seihou.Core.Seed (renderManifestInvariantError, seedApplicationIds, validateManifestInvariants)@@ -82,8 +83,11 @@ -- change advances this number is -- docs/adr/0014-every-semantic-manifest-change-advances-the-schema-version.md. -- Schema 13 records application recipe-chain evidence; null denotes unknown history.+-- Schema 14 records conditional removal policies and single-root closure retirement.+-- Missing removal conditions remain unconditional; 13 -> 14 adds null instance+-- policies where accepted typed evidence is unknown. currentManifestVersion :: ManifestSchemaVersion-currentManifestVersion = ManifestSchemaVersion 13+currentManifestVersion = ManifestSchemaVersion 14  -- | The oldest schema the ordinary decoder reads. Anything older records -- machine-specific absolute paths and must go through the explicit@@ -99,6 +103,7 @@ minimumManifestVersion SeedReceipts = ManifestSchemaVersion 8 minimumManifestVersion RecipeInputs = ManifestSchemaVersion 12 minimumManifestVersion RecipeInheritance = ManifestSchemaVersion 13+minimumManifestVersion ConditionalRemovalPolicies = ManifestSchemaVersion 14 minimumManifestVersion SeedOwnerClaims = ManifestSchemaVersion 11 minimumManifestVersion CheckoutLocalOutputs = ManifestSchemaVersion 9 minimumManifestVersion CheckoutLocalCommands = ManifestSchemaVersion 10@@ -252,6 +257,7 @@         <*> o Aeson..:? "recipe"         <*> o Aeson..:? "blueprint"         <*> o Aeson..:? "blueprintMigrations" Aeson..!= []+    unless (manifestSupports ConditionalRemovalPolicies manifest || not (hasConditionalRemoval manifest || hasRemovalPolicy manifest)) $ fail "conditional removal policies require manifest schema 14"     case validateManifestInvariants manifest of       Left err -> fail (T.unpack (renderManifestInvariantError err))       Right () -> case validateCheckoutRecords manifest [] of@@ -359,19 +365,23 @@ legacyLocalOrigin recordedName = fromMaybe (LocalOrigin recordedName)  instance ToJSON AppliedInstanceState where-  toJSON state =-    Aeson.object $-      [ "name" .= (state ^. #name . #unModuleName),-        "origin" .= (state ^. #origin),-        "resolvedVars" .= varsToJSON (state ^. #resolvedVars)-      ]-        ++ parentVarsField (state ^. #parentVars)-        ++ maybe [] (\v -> ["version" .= v]) (state ^. #moduleVersion)-    where-      parentVarsField (ParentVars m)-        | Map.null m = []-        | otherwise = ["parentVars" .= parentVarsMapToJSON m]+  toJSON = instanceToJSON currentManifestVersion +instanceToJSON :: ManifestSchemaVersion -> AppliedInstanceState -> Aeson.Value+instanceToJSON schema state =+  Aeson.object $+    [ "name" .= (state ^. #name . #unModuleName),+      "origin" .= (state ^. #origin),+      "resolvedVars" .= varsToJSON (state ^. #resolvedVars)+    ]+      ++ ["removalPolicy" .= fmap removalToJSON (state ^. #removalPolicy) | schema >= ManifestSchemaVersion 14]+      ++ parentVarsField (state ^. #parentVars)+      ++ maybe [] (\v -> ["version" .= v]) (state ^. #moduleVersion)+  where+    parentVarsField (ParentVars m)+      | Map.null m = []+      | otherwise = ["parentVars" .= parentVarsMapToJSON m]+ instance FromJSON AppliedInstanceState where   parseJSON = Aeson.withObject "AppliedInstanceState" $ \o -> do     mParentVars <- o Aeson..:? "parentVars"@@ -384,6 +394,7 @@       <*> o .: "origin"       <*> o Aeson..:? "version"       <*> (varsFromJSON =<< o Aeson..:? "resolvedVars" Aeson..!= Aeson.object [])+      <*> (o Aeson..:? "removalPolicy" >>= traverse parseRemovalJSON)  instance ToJSON AppliedComposition where   toJSON = applicationToJSON currentManifestVersion@@ -395,7 +406,7 @@       "target" .= (composition ^. #target),       "targetOrigin" .= (composition ^. #targetOrigin),       "additionalModules" .= map (^. #unModuleName) (composition ^. #additionalModules),-      "instances" .= (composition ^. #instances),+      "instances" .= map (instanceToJSON schema) (composition ^. #instances),       "appliedAt" .= (composition ^. #appliedAt)     ]       ++ maybe [] (\v -> ["targetVersion" .= v]) (composition ^. #targetVersion)@@ -428,6 +439,11 @@   when (schema < minimumManifestVersion RecipeInheritance) $ do     legacyChain <- o Aeson..:? "recipeChain" :: Aeson.Parser (Maybe Aeson.Value)     unless (legacyChain == Nothing) (fail "recipe chain requires manifest schema 13")+  rawInstances <- o Aeson..:? "instances" Aeson..!= []+  instances <- forM rawInstances $ \value -> do+    when (schema >= minimumManifestVersion ConditionalRemovalPolicies) $+      Aeson.withObject "AppliedInstanceState" (\fields -> unless (KM.member "removalPolicy" fields) (fail "schema 14 instance requires removalPolicy (null for unknown legacy policy)")) value+    parseJSON value   composition <-     AppliedComposition       <$> (ApplicationId <$> o .: "applicationId")@@ -437,7 +453,7 @@       <*> (map ModuleName <$> o Aeson..:? "additionalModules" Aeson..!= [])       <*> o Aeson..:? "namespace"       <*> o Aeson..:? "context"-      <*> o Aeson..:? "instances" Aeson..!= []+      <*> pure instances       <*> (commandReceiptsFromJSON =<< o Aeson..:? "commandReceipts" Aeson..!= Aeson.object [])       <*> pure commands       <*> (if schema >= ManifestSchemaVersion 12 then traverse varsFromJSON =<< o .: "recipeInputs" else pure Nothing)@@ -645,6 +661,16 @@   m <- parseJSON v :: Aeson.Parser (Map Text Text)   pure (Map.mapKeys VarName m) +-- | All accepted policies, including per-application instance receipts.+recordedRemovals :: Manifest -> [Removal]+recordedRemovals manifest = [spec | applied <- manifest ^. #modules, spec <- maybe [] pure (applied ^. #removal)] <> [spec | app <- manifest ^. #applications, state <- app ^. #instances, spec <- maybe [] pure (state ^. #removalPolicy)]++hasRemovalPolicy :: Manifest -> Bool+hasRemovalPolicy manifest = or [isJust (state ^. #removalPolicy) | app <- manifest ^. #applications, state <- app ^. #instances]++hasConditionalRemoval :: Manifest -> Bool+hasConditionalRemoval manifest = or [isJust (step ^. #condition) | applied <- manifest ^. #modules, spec <- maybe [] pure (applied ^. #removal), step <- spec ^. #steps]+ -- | Encode a Removal to JSON. removalToJSON :: Removal -> Aeson.Value removalToJSON r =@@ -660,6 +686,7 @@       "dest" .= (s ^. #dest)     ]       ++ maybe [] (\p -> ["src" .= p]) (s ^. #src)+      ++ maybe [] (\expr -> ["when" .= case expr of ExprLit value -> Aeson.Bool value; _ -> Aeson.String (renderExpr expr)]) (s ^. #condition)  removalActionToText :: RemovalAction -> Text removalActionToText RemoveFileAction = "remove-file"@@ -685,6 +712,7 @@     <$> (parseRemovalActionText =<< o .: "action")     <*> o .: "dest"     <*> o Aeson..:? "src"+    <*> (fmap ExprLit <$> o Aeson..:? "when")  parseRemovalActionText :: Text -> Aeson.Parser RemovalAction parseRemovalActionText "remove-file" = pure RemoveFileAction@@ -903,6 +931,9 @@     <> ["recipe inputs require manifest schema 12" | not (manifestSupports RecipeInputs manifest), any (isJust . (^. #recipeInputs)) (manifest ^. #applications)]     <> ["seed owner claims require manifest schema 11" | not (manifestSupports SeedOwnerClaims manifest), any (\r -> case r ^. #ownership of KnownSeedOwners _ -> True; _ -> False) (Map.elems (manifest ^. #seeds))]     <> either (pure . T.pack) (const []) (Aeson.parseEither (const (validateCheckoutCommands manifest)) Aeson.Null)+    <> ["conditional removal policies must record a typed boolean result" | spec <- recordedRemovals manifest, step <- spec ^. #steps, Just expr <- [step ^. #condition], case expr of ExprLit _ -> False; _ -> True]+    <> ["instance removal policies require manifest schema 14" | not (manifestSupports ConditionalRemovalPolicies manifest), hasRemovalPolicy manifest]+    <> ["conditional removal policies require manifest schema 14" | not (manifestSupports ConditionalRemovalPolicies manifest), hasConditionalRemoval manifest]     <> ["removal commands cannot declare checkout setup" | applied <- manifest ^. #modules, removal <- maybe [] pure (applied ^. #removal), any ((== CheckoutCommandLifecycle) . (^. #lifecycle)) (removal ^. #commands)]     <> ["checkout commands require manifest schema 10" | manifest ^. #version < ManifestSchemaVersion 10, any (not . null . (^. #checkoutCommands)) (manifest ^. #applications)]     <> ["checkout outputs require manifest schema 9" | manifest ^. #version < ManifestSchemaVersion 9, not (Map.null (manifest ^. #checkoutOutputs))]

@@ -33,7 +33,7 @@   ) where -import Control.Monad (foldM, forM, unless, when)+import Control.Monad (foldM, forM, forM_, unless, when) import Data.Aeson qualified as Aeson import Data.Aeson.Key qualified as Key import Data.Aeson.KeyMap qualified as KeyMap@@ -60,6 +60,7 @@   | AddEmptySeedReceipts   | AddEmptyCheckoutOutputs   | AddUnknownRecipeInputs+  | IntroduceConditionalRemoval   | AddUnknownRecipeChain   | MakeSeedOwnershipExplicit   | AddEmptyCheckoutCommands@@ -126,7 +127,8 @@     step 9 AddEmptyCheckoutCommands "repeatable checkout commands",     step 10 MakeSeedOwnershipExplicit "explicit seed instance ownership",     step 11 AddUnknownRecipeInputs "recipe inputs",-    step 12 AddUnknownRecipeChain "recipe inheritance provenance"+    step 12 AddUnknownRecipeChain "recipe inheritance provenance",+    step 13 IntroduceConditionalRemoval "conditional removal policies and recorded root retirement"   ]   where     step from stepAction =@@ -135,6 +137,7 @@ upgradeStepKind :: UpgradeStepAction -> UpgradeStepKind upgradeStepKind AddUnknownRecipeInputs = LosslessUpgrade upgradeStepKind AddUnknownRecipeChain = LosslessUpgrade+upgradeStepKind IntroduceConditionalRemoval = LosslessUpgrade upgradeStepKind StampVersion = LosslessUpgrade upgradeStepKind ConvertMachineLocalPaths = InferenceBearingUpgrade upgradeStepKind MakeSharedWriteEvidenceExplicit = LosslessUpgrade@@ -196,6 +199,9 @@   unless (actual == upgradeStep ^. #fromVersion) $     Left (StepVersionMismatch upgradeStep actual)   transformed <- case upgradeStep ^. #action of+    IntroduceConditionalRemoval -> do+      validateUnconditionalRemovals actual document+      addUnknownRemovalPolicies actual document     AddUnknownRecipeChain -> case document of       Aeson.Object fields -> do         apps <- case KeyMap.lookup "applications" fields of@@ -350,3 +356,60 @@     add (Aeson.Object fields) = Aeson.Object (KeyMap.insert "recipeInputs" Aeson.Null fields)     add other = other addInputs other = other++-- Schema 13 has no conditional-removal evidence. Do not legitimize a future field+-- merely by stamping its document with a newer version; preserve all unrelated keys.+validateUnconditionalRemovals :: ManifestSchemaVersion -> Aeson.Value -> Either ManifestUpgradeError ()+validateUnconditionalRemovals version = \case+  Aeson.Object fields -> do+    modules <- values (fromMaybe (Aeson.Array mempty) (KeyMap.lookup "modules" fields))+    forM_ modules $ \case+      Aeson.Object modul -> case KeyMap.lookup "removal" modul of+        Nothing -> Right ()+        Just Aeson.Null -> Right ()+        Just (Aeson.Object removal) -> do+          steps <- values (fromMaybe (Aeson.Array mempty) (KeyMap.lookup "steps" removal))+          forM_ steps $ \case+            Aeson.Object step -> case KeyMap.lookup "when" step of+              Nothing -> Right ()+              Just Aeson.Null -> Right ()+              _ -> bad "schema 13 cannot contain conditional removal policies"+            _ -> bad "removal step must be an object"+        _ -> bad "removal must be an object"+      _ -> bad "module must be an object"+  _ -> bad "manifest must be an object"+  where+    bad :: Text -> Either ManifestUpgradeError a+    bad = Left . MalformedDocument version+    values value = case Aeson.fromJSON value of+      Aeson.Success xs -> Right (xs :: [Aeson.Value])+      Aeson.Error err -> bad (T.pack err)++-- The old reader never accepted typed per-application policy results. Preserve+-- unknown fields and explicitly record that historical evidence is unavailable.+addUnknownRemovalPolicies :: ManifestSchemaVersion -> Aeson.Value -> Either ManifestUpgradeError Aeson.Value+addUnknownRemovalPolicies version (Aeson.Object fields) = case KeyMap.lookup "applications" fields of+  Nothing -> Right (Aeson.Object fields)+  Just value -> do+    apps <- values value+    upgraded <- forM apps $ \case+      Aeson.Object app -> case KeyMap.lookup "instances" app of+        Nothing -> Right (Aeson.Object app)+        Just states -> do+          instances <- values states+          converted <- forM instances $ \case+            Aeson.Object state -> case KeyMap.lookup "removalPolicy" state of+              Nothing -> Right (Aeson.Object (KeyMap.insert "removalPolicy" Aeson.Null state))+              Just Aeson.Null -> Right (Aeson.Object state)+              _ -> bad "schema 13 cannot contain per-application removal policy evidence"+            _ -> bad "instance must be an object"+          Right (Aeson.Object (KeyMap.insert "instances" (Aeson.toJSON converted) app))+      _ -> bad "application must be an object"+    Right (Aeson.Object (KeyMap.insert "applications" (Aeson.toJSON upgraded) fields))+  where+    bad :: Text -> Either ManifestUpgradeError a+    bad = Left . MalformedDocument version+    values value = case Aeson.fromJSON value of+      Aeson.Success xs -> Right (xs :: [Aeson.Value])+      Aeson.Error err -> bad (T.pack err)+addUnknownRemovalPolicies version _ = Left (MalformedDocument version "manifest must be an object")

@@ -1,6 +1,6 @@ module Seihou.Core.ApplicationSpec (tests) where -import Control.Lens ((&), (?~), (^.))+import Control.Lens ((&), (.~), (?~), (^.)) import Control.Monad (forM_) import Data.Generics.Labels () import Data.Map.Strict qualified as Map@@ -115,6 +115,17 @@       map (^. #parentVars) (composition ^. #instances) `shouldBe` [pv1, pv2]       map (^. #resolvedVars) (composition ^. #instances)         `shouldBe` [Map.singleton "skill.name" "exec-plan", Map.singleton "skill.name" "master-plan"]++    it "settles removal while Boolean and text values retain their declared types" $ do+      let inst = ModuleInstance "dep" emptyParentVars+          condition = ExprEq (VarName "flag") (VBool True)+          policy = Removal [RemovalStep RemoveFileAction "starter.txt" Nothing (Just condition)] []+          modul = mkModule "dep" Nothing & #removal .~ Just policy+          build value = buildAppliedComposition moduleTarget (LocalOrigin "root") Nothing [] Nothing Nothing [(inst, modul, LocalOrigin "dep")] (Map.singleton inst (Map.singleton "flag" (mkResolved "flag" value))) fixedTime+          expected result = [Just (Removal [RemovalStep RemoveFileAction "starter.txt" Nothing (Just (ExprLit result))] [])]+      map (^. #removalPolicy) (build (VBool True) ^. #instances) `shouldBe` expected True+      map (^. #removalPolicy) (build (VText "true") ^. #instances) `shouldBe` expected False+      map (^. #resolvedVars) (build (VBool True) ^. #instances) `shouldBe` map (^. #resolvedVars) (build (VText "true") ^. #instances)      it "keeps identity independent of versions, source paths, and resolved values" $ do       let inst = ModuleInstance "dep" emptyParentVars

@@ -39,7 +39,7 @@           []           Nothing           Nothing-          [AppliedInstanceState name emptyParentVars (LocalOrigin (name ^. #unModuleName)) Nothing Map.empty | name <- ["demo", "second"]]+          [AppliedInstanceState name emptyParentVars (LocalOrigin (name ^. #unModuleName)) Nothing Map.empty Nothing | name <- ["demo", "second"]]           Map.empty           []           Nothing@@ -123,7 +123,7 @@       checkSeedSteps patched `shouldSatisfy` (not . null)       checkSeedSteps (seed & #steps %~ map (#strategy .~ Structured)) `shouldSatisfy` (not . null)       checkSeedSteps (seed & #steps %~ (<> map (#lifecycle .~ Managed) (seed ^. #steps))) `shouldSatisfy` (not . null)-      checkSeedSteps (seed & #removal ?~ Removal [RemovalStep RemoveFileAction "b" Nothing] []) `shouldSatisfy` (not . null)+      checkSeedSteps (seed & #removal ?~ Removal [RemovalStep RemoveFileAction "b" Nothing Nothing] []) `shouldSatisfy` (not . null)       TIO.writeFile (dir </> "module.dhall") (source ", lifecycle = Some \"sede\"")       invalid <- evalModuleFromFile (dir </> "module.dhall")       invalid `shouldSatisfy` isLeft

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

@@ -1,6 +1,6 @@ module Seihou.Engine.RemoveSpec (tests) where -import Control.Lens ((&), (.~), (^.))+import Control.Lens ((%~), (&), (.~), (^.)) import Data.Generics.Labels () import Data.Map.Strict qualified as Map import Data.Set qualified as Set@@ -81,7 +81,7 @@ spec = do   describe "seed preservation and exact selection" $ do     let appId = ApplicationId "a"-        app = AppliedComposition appId (AppliedModuleTarget modName) (LocalOrigin "test-module") Nothing [] Nothing Nothing [AppliedInstanceState name emptyParentVars (LocalOrigin text) Nothing Map.empty | (name, text) <- [(modName, "test-module"), (otherMod, "other-module")]] Map.empty [] Nothing Nothing fixedTime+        app = AppliedComposition appId (AppliedModuleTarget otherMod) (LocalOrigin "test-module") Nothing [] Nothing Nothing [AppliedInstanceState name emptyParentVars (LocalOrigin text) Nothing Map.empty Nothing | (name, text) <- [(modName, "test-module"), (otherMod, "other-module")]] Map.empty [] Nothing Nothing fixedTime         receipt = SeedRecord modName (KnownSeedOwners (Map.singleton appId (Set.fromList [modName, otherMod]))) SeedCreated fixedTime         manifest = mkManifest False [] & #applications .~ [app] & #seeds .~ Map.singleton "seed.txt" receipt     it "retires a no-spec instance without losing a co-seeder or original supplier" $ do@@ -90,7 +90,7 @@       fmap (^. #ownership) (Map.lookup "seed.txt" (candidate ^. #seeds)) `shouldBe` Just (KnownSeedOwners (Map.singleton appId (Set.singleton otherMod)))       fmap (^. #moduleName) (Map.lookup "seed.txt" (candidate ^. #seeds)) `shouldBe` Just modName     it "keeps every declarative removal form without needing to read seed content" $ do-      let removal = Removal [RemovalStep action "seed.txt" (Just "rewrite.dhall") | action <- [RemoveFileAction, RemoveSectionAction, RewriteFileAction]] []+      let removal = Removal [RemovalStep action "seed.txt" (Just "rewrite.dhall") Nothing | action <- [RemoveFileAction, RemoveSectionAction, RewriteFileAction]] []       Right plan <- pure (runBuildOps emptyFS manifest modName removal)       plan ^. #ops `shouldBe` replicate 3 (KeepSeedOp "seed.txt")     it "defends direct supplied operations, including path aliases, at execution too" $ do@@ -102,6 +102,60 @@       let legacy = manifest & #seeds .~ Map.singleton "seed.txt" (receipt & #ownership .~ LegacySeedOwners (Set.singleton appId))       selectRecordedRemoval legacy modName Nothing `shouldSatisfy` either (const True) (const False) +  describe "recorded root closure and conditional removal" $ do+    let appId = ApplicationId "root"+        variables = Map.singleton (VarName "base.starters") "false"+        rootApp = AppliedComposition appId (AppliedModuleTarget modName) (LocalOrigin "root") Nothing [] Nothing Nothing [AppliedInstanceState name emptyParentVars (LocalOrigin "fixture") Nothing variables (Just (if name == otherMod then settleRemovalConditions (Map.singleton (VarName "base.starters") (VBool False)) baseSpec else rootSpec)) | name <- [otherMod, modName]] Map.empty [] Nothing Nothing fixedTime+        baseSpec = Removal [RemovalStep RemoveFileAction "base.txt" Nothing Nothing, RemovalStep RemoveFileAction "package.json" Nothing (Just (ExprEq (VarName "base.starters") (VBool True)))] []+        rootSpec = Removal [RemovalStep RemoveFileAction "client.txt" Nothing Nothing] []+        applied name spec = AppliedModule name emptyParentVars (LocalOrigin "fixture") Nothing fixedTime (Just spec)+        file name owners = FileRecord (hashContent "bytes") name Template fixedTime Nothing owners SharedWriteUnknown+        manifest =+          (emptyManifest fixedTime)+            & #applications .~ [rootApp]+            & #modules .~ [applied otherMod (settleRemovalConditions (Map.singleton (VarName "base.starters") (VBool False)) baseSpec), applied modName rootSpec]+            & #files .~ Map.fromList [("base.txt", file otherMod (Set.singleton appId)), ("client.txt", file modName (Set.singleton appId))]+            & #seeds .~ Map.singleton "package.json" (SeedRecord modName (KnownSeedOwners (Map.singleton appId (Set.singleton modName))) SeedCreated fixedTime)+    it "retires an unshared inherited closure and uses recorded per-instance conditions" $ do+      Right (Just selected) <- pure (selectRecordedRemoval manifest modName Nothing)+      selected ^. #candidateManifest . #applications `shouldBe` []+      selected ^. #candidateManifest . #modules `shouldBe` []+      selected ^. #candidateManifest . #files `shouldBe` Map.empty+      fmap (map (^. #dest) . (^. #steps)) (selected ^. #removal) `shouldBe` Just ["client.txt", "base.txt"]+    it "uses application dependency order when shared module summaries were reordered" $ do+      Right (Just selected) <- pure (selectRecordedRemoval (manifest & #modules %~ reverse) modName Nothing)+      fmap (map (^. #dest) . (^. #steps)) (selected ^. #removal) `shouldBe` Just ["client.txt", "base.txt"]+    it "selects a recorded managed root even without seed or checkout receipts" $ do+      Right (Just selected) <- pure (selectRecordedRemoval (manifest & #seeds .~ Map.empty) modName Nothing)+      selected ^. #candidateManifest . #applications `shouldBe` []+      selected ^. #candidateManifest . #modules `shouldBe` []+    it "keeps an inherited module claimed by another application" $ do+      let otherId = ApplicationId "survivor"+          survivor = rootApp & #applicationId .~ otherId & #target .~ AppliedModuleTarget otherMod & #instances %~ filter ((== otherMod) . (^. #name))+          shared = manifest & #applications %~ (<> [survivor]) & #files %~ Map.adjust (\record -> record & #applicationIds %~ Set.insert otherId) "base.txt"+      Right (Just selected) <- pure (selectRecordedRemoval shared modName Nothing)+      fmap (map (^. #dest) . (^. #steps)) (selected ^. #removal) `shouldBe` Just ["client.txt"]+      map (^. #name) (selected ^. #candidateManifest . #modules) `shouldBe` [otherMod]+      Map.keys (selected ^. #candidateManifest . #files) `shouldBe` ["base.txt"]+    it "uses the departing application's receipt even when a shared module summary differs" $ do+      let laterSummary = manifest & #modules %~ map (\entry -> if entry ^. #name == otherMod then entry & #removal .~ Just (settleRemovalConditions (Map.singleton (VarName "base.starters") (VBool True)) baseSpec) else entry)+      Right (Just selected) <- pure (selectRecordedRemoval laterSummary modName Nothing)+      fmap (map (^. #dest) . (^. #steps)) (selected ^. #removal) `shouldBe` Just ["client.txt", "base.txt"]+    it "requires ordinary adoption when a conditional legacy application has no receipt" $ do+      let unknown = manifest & #applications %~ map (\app -> app & #instances %~ map (\state -> state & #removalPolicy .~ Nothing))+      selectRecordedRemoval unknown modName Nothing `shouldSatisfy` either (const True) (const False)+    it "preserves type-sensitive conditions and refuses unresolved policy" $ do+      let fs = mkFS [("package.json", "bytes"), ("base.txt", "bytes")]+          legacy = mkManifestWithRemoval baseSpec [("package.json", "bytes"), ("base.txt", "bytes")]+          settle value = settleRemovalConditions (Map.singleton (VarName "base.starters") value) baseSpec+      Right yes <- pure (runBuildOps fs legacy modName (settle (VBool True)))+      Right no <- pure (runBuildOps fs legacy modName (settle (VBool False)))+      Right text <- pure (runBuildOps fs legacy modName (settle (VText "true")))+      length (yes ^. #ops) `shouldBe` 2+      length (no ^. #ops) `shouldBe` 1+      length (text ^. #ops) `shouldBe` 1+      runBuildOps fs legacy modName baseSpec `shouldSatisfy` either (const True) (const False)+   describe "computeRemovalPlan" $ do     it "returns ModuleNotApplied when module is not in manifest" $ do       let manifest = emptyManifest fixedTime@@ -227,7 +281,7 @@       result `shouldBe` Left (ModuleNotApplied modName)      it "builds DeleteFileOp with RFSafe for unchanged files" $ do-      let removal = Removal [RemovalStep RemoveFileAction "README.md" Nothing] []+      let removal = Removal [RemovalStep RemoveFileAction "README.md" Nothing Nothing] []           manifest = mkManifestWithRemoval removal [("README.md", "hello")]           fs = mkFS [("README.md", "hello")]           result = runBuildOps fs manifest modName removal@@ -236,7 +290,7 @@         Right plan -> (plan ^. #ops) `shouldBe` [DeleteFileOp "README.md" RFSafe]      it "builds DeleteFileOp with RFConflict for modified files" $ do-      let removal = Removal [RemovalStep RemoveFileAction "README.md" Nothing] []+      let removal = Removal [RemovalStep RemoveFileAction "README.md" Nothing Nothing] []           manifest = mkManifestWithRemoval removal [("README.md", "original")]           fs = mkFS [("README.md", "user changed this")]           result = runBuildOps fs manifest modName removal@@ -245,7 +299,7 @@         Right plan -> (plan ^. #ops) `shouldBe` [DeleteFileOp "README.md" RFConflict]      it "builds DeleteFileOp with RFGone for already-deleted files" $ do-      let removal = Removal [RemovalStep RemoveFileAction "README.md" Nothing] []+      let removal = Removal [RemovalStep RemoveFileAction "README.md" Nothing Nothing] []           manifest = mkManifestWithRemoval removal [("README.md", "hello")]           result = runBuildOps emptyFS manifest modName removal       case result of@@ -253,7 +307,7 @@         Right plan -> (plan ^. #ops) `shouldBe` [DeleteFileOp "README.md" RFGone]      it "builds StripSectionOp for remove-section steps" $ do-      let removal = Removal [RemovalStep RemoveSectionAction ".gitignore" Nothing] []+      let removal = Removal [RemovalStep RemoveSectionAction ".gitignore" Nothing Nothing] []           manifest = mkManifestWithRemoval removal [(".gitignore", "content")]           fs = mkFS [(".gitignore", "content")]           result = runBuildOps fs manifest modName removal@@ -270,7 +324,7 @@         Right plan -> (plan ^. #ops) `shouldBe` [RemovalCommandOp "cabal clean" Nothing]      it "rejects a removal step destination with a parent directory segment" $ do-      let removal = Removal [RemovalStep RemoveFileAction "../outside" Nothing] []+      let removal = Removal [RemovalStep RemoveFileAction "../outside" Nothing Nothing] []           manifest = mkManifestWithRemoval removal []           fs = mkFS [("../outside", "do not delete")]           result = runBuildOps fs manifest modName removal@@ -298,7 +352,7 @@     it "combines steps and commands in order" $ do       let removal =             Removal-              [RemovalStep RemoveFileAction "a.txt" Nothing, RemovalStep RemoveSectionAction ".gitignore" Nothing]+              [RemovalStep RemoveFileAction "a.txt" Nothing Nothing, RemovalStep RemoveSectionAction ".gitignore" Nothing Nothing]               [Command "echo done" Nothing Nothing ApplicationCommand]           manifest = mkManifestWithRemoval removal [("a.txt", "aaa")]           fs = mkFS [("a.txt", "aaa"), (".gitignore", "stuff")]@@ -313,7 +367,7 @@    describe "executeRemovalOps" $ do     it "deletes files with DeleteFileOp" $ do-      let removal = Removal [RemovalStep RemoveFileAction "README.md" Nothing] []+      let removal = Removal [RemovalStep RemoveFileAction "README.md" Nothing Nothing] []           manifest = mkManifestWithRemoval removal [("README.md", "hello")]           fs = mkFS [("README.md", "hello")]           plan = ExecutedRemovalPlan modName [DeleteFileOp "README.md" RFSafe]@@ -321,7 +375,7 @@       Map.member "README.md" (finalFS ^. #files) `shouldBe` False      it "preserves files in keep-set for DeleteFileOp" $ do-      let removal = Removal [RemovalStep RemoveFileAction "a.txt" Nothing] []+      let removal = Removal [RemovalStep RemoveFileAction "a.txt" Nothing Nothing] []           manifest = mkManifestWithRemoval removal [("a.txt", "aaa")]           fs = mkFS [("a.txt", "modified")]           plan = ExecutedRemovalPlan modName [DeleteFileOp "a.txt" RFConflict]@@ -356,7 +410,7 @@       Map.lookup "file.txt" (finalFS ^. #files) `shouldBe` Just content      it "removes module from manifest after all steps" $ do-      let removal = Removal [RemovalStep RemoveFileAction "a.txt" Nothing] []+      let removal = Removal [RemovalStep RemoveFileAction "a.txt" Nothing Nothing] []           manifest = mkManifestWithRemoval removal [("a.txt", "aaa")]           fs = mkFS [("a.txt", "aaa")]           plan = ExecutedRemovalPlan modName [DeleteFileOp "a.txt" RFSafe]

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

@@ -96,14 +96,16 @@                        parentVars = emptyParentVars,                        origin = ProjectOrigin ".seihou/modules/docs",                        moduleVersion = Just "0.1.0",-                       resolvedVars = Map.empty+                       resolvedVars = Map.empty,+                       removalPolicy = Nothing                      },                    AppliedInstanceState                      { name = ModuleName "scratch",                        parentVars = emptyParentVars,                        origin = LocalOrigin "scratch",                        moduleVersion = Nothing,-                       resolvedVars = Map.empty+                       resolvedVars = Map.empty,+                       removalPolicy = Nothing                      }                  ],                commandReceipts = Map.empty,@@ -137,7 +139,7 @@                removal =                  Just                    ( Removal-                       [RemovalStep RemoveFileAction "flake.nix" (Just "files/flake.nix")]+                       [RemovalStep RemoveFileAction "flake.nix" (Just "files/flake.nix") (Just (ExprLit True))]                        [Command "cabal clean" (Just "backend") Nothing ApplicationCommand]                    )              }@@ -297,7 +299,7 @@    describe "checkout command codec" $ do     let command = CheckoutCommand "demo" 0 "mkdir -p .local/setup" Nothing-        application commands = AppliedComposition (ApplicationId "setup") (AppliedModuleTarget "demo") (ProjectOrigin "modules/demo") (Just "1") [] Nothing Nothing [AppliedInstanceState "demo" emptyParentVars (ProjectOrigin "modules/demo") (Just "1") Map.empty] Map.empty commands Nothing Nothing fixedTime+        application commands = AppliedComposition (ApplicationId "setup") (AppliedModuleTarget "demo") (ProjectOrigin "modules/demo") (Just "1") [] Nothing Nothing [AppliedInstanceState "demo" emptyParentVars (ProjectOrigin "modules/demo") (Just "1") Map.empty Nothing] Map.empty commands Nothing Nothing fixedTime         manifest commands = emptyManifest fixedTime & #applications .~ [application commands]         mutateApp transform value = case value of           Aeson.Object fields -> case KeyMap.lookup "applications" fields of@@ -337,6 +339,40 @@       (m ^. #files) `shouldBe` Map.empty       (m ^. #blueprintMigrations) `shouldBe` [] +  describe "conditional removal policy codec" $ do+    let policy = Removal [RemovalStep RemoveFileAction "package.json" Nothing (Just (ExprLit True))] []+        applied = AppliedModule (ModuleName "base") emptyParentVars (LocalOrigin "base") Nothing fixedTime (Just policy)+        manifest = emptyManifest fixedTime & #modules .~ [applied]+    it "roundtrips the condition at schema 14" $+      manifestFromJSON (manifestToJSON manifest) `shouldBe` Right manifest+    it "roundtrips per-application policy and rejects missing or unresolved accepted evidence" $ do+      let state = AppliedInstanceState "base" emptyParentVars (LocalOrigin "base") Nothing Map.empty (Just policy)+          app = AppliedComposition (ApplicationId "base") (AppliedModuleTarget "base") (LocalOrigin "base") Nothing [] Nothing Nothing [state] Map.empty [] Nothing Nothing fixedTime+          recorded = manifest & #applications .~ [app]+          alterInstances f (Aeson.Object fields) = Aeson.Object (update "applications" (mapArray (alterApp f)) fields)+          alterInstances _ value = value+          mapArray f (Aeson.Array values) = Aeson.Array (fmap f values)+          mapArray _ value = value+          alterApp f (Aeson.Object fields) = Aeson.Object (update "instances" (mapArray (\case Aeson.Object fields' -> Aeson.Object (f fields'); value -> value)) fields)+          alterApp _ value = value+          update key f fields = maybe fields (\value -> KeyMap.insert key (f value) fields) (KeyMap.lookup key fields)+          withoutPolicy = alterInstances (KeyMap.delete "removalPolicy") (Aeson.toJSON recorded)+          unresolved = recorded & #applications %~ map (\entry -> entry & #instances %~ map (\instanceState -> instanceState & #removalPolicy .~ Just (Removal [RemovalStep RemoveFileAction "starter" Nothing (Just (ExprEq "flag" (VBool True)))] [])))+      manifestFromJSON (manifestToJSON recorded) `shouldBe` Right recorded+      manifestFromJSON (Aeson.encode withoutPolicy) `shouldSatisfy` either (const True) (const False)+      manifestEncodingLoss unresolved `shouldSatisfy` (not . null)+      manifestFromJSON (manifestToJSON unresolved) `shouldSatisfy` either (const True) (const False)++    it "rejects conditional evidence in an older schema instead of ignoring it" $ do+      let old = manifest & #version .~ ManifestSchemaVersion 13+      manifestEncodingLoss old `shouldSatisfy` (not . null)+      manifestFromJSON (manifestToJSON old) `shouldSatisfy` either (const True) (const False)++    it "rejects an unresolved expression instead of reinterpreting saved text" $ do+      let unresolved = manifest & #modules %~ map (\entry -> entry & #removal %~ fmap (\spec -> spec & #steps %~ map (\step -> step & #condition .~ Just (ExprEq (VarName "base.starters") (VBool True)))))+      manifestEncodingLoss unresolved `shouldSatisfy` (not . null)+      manifestFromJSON (manifestToJSON unresolved) `shouldSatisfy` either (const True) (const False)+   describe "ArtifactOrigin" $ do     it "roundtrips a remote origin carrying a repository name" $ do       let origin = RemoteOrigin "https://github.com/shinzui/seihou-modules.git" "haskell-base" (Just "seihou-modules")@@ -543,8 +579,8 @@                 namespace = Just "planning",                 context = Just "work",                 instances =-                  [ AppliedInstanceState (ModuleName "link-skill") pv1 (LocalOrigin "link-skill") (Just "1") (Map.singleton (VarName "skill.name") "exec-plan"),-                    AppliedInstanceState (ModuleName "link-skill") pv2 (LocalOrigin "link-skill") (Just "1") (Map.singleton (VarName "skill.name") "master-plan")+                  [ AppliedInstanceState (ModuleName "link-skill") pv1 (LocalOrigin "link-skill") (Just "1") (Map.singleton (VarName "skill.name") "exec-plan") Nothing,+                    AppliedInstanceState (ModuleName "link-skill") pv2 (LocalOrigin "link-skill") (Just "1") (Map.singleton (VarName "skill.name") "master-plan") Nothing                   ],                 commandReceipts = Map.singleton fingerprint receipt,                 checkoutCommands = [],

@@ -63,6 +63,21 @@  spec :: Spec spec = do+  it "upgrades unconditional schema-13 removal without changing producer fields" $ do+    let document = Aeson.object ["version" Aeson..= (13 :: Int), "producerField" Aeson..= True, "modules" Aeson..= [Aeson.object ["removal" Aeson..= Aeson.object ["steps" Aeson..= [Aeson.object ["action" Aeson..= ("remove-file" :: String), "dest" Aeson..= ("package.json" :: String)]]]]]]+    case upgradeDocumentLosslessly (v 14) document of+      Right (_, upgraded) -> upgraded `shouldBe` setDocumentSchemaVersion (v 14) document+      Left err -> expectationFailure (show err)+  it "adds unknown instance removal evidence losslessly without manufacturing an outcome" $ do+    let state = Aeson.object ["producerInstance" Aeson..= True]+        document = Aeson.object ["version" Aeson..= (13 :: Int), "applications" Aeson..= [Aeson.object ["instances" Aeson..= [state], "producerApplication" Aeson..= True]]]+        expected = Aeson.object ["version" Aeson..= (14 :: Int), "applications" Aeson..= [Aeson.object ["instances" Aeson..= [Aeson.object ["producerInstance" Aeson..= True, "removalPolicy" Aeson..= Aeson.Null]], "producerApplication" Aeson..= True]]]+    fmap snd (upgradeDocumentLosslessly (v 14) document) `shouldBe` Right expected+    let forged = Aeson.object ["version" Aeson..= (13 :: Int), "applications" Aeson..= [Aeson.object ["instances" Aeson..= [Aeson.object ["removalPolicy" Aeson..= Aeson.object []]]]]]+    upgradeDocumentLosslessly (v 14) forged `shouldSatisfy` either (const True) (const False)+  it "refuses conditional evidence in a schema-13 document" $ do+    let document = Aeson.object ["version" Aeson..= (13 :: Int), "modules" Aeson..= [Aeson.object ["removal" Aeson..= Aeson.object ["steps" Aeson..= [Aeson.object ["when" Aeson..= ("true" :: String)]]]]]]+    upgradeDocumentLosslessly (v 14) document `shouldSatisfy` either (const True) (const False)   it "upgrades schema 12 with unknown recipe chain history and preserves unknown raw fields" $ do     let document = Aeson.object ["version" Aeson..= (12 :: Int), "futureTop" Aeson..= True, "applications" Aeson..= [Aeson.object ["producerOwned" Aeson..= True]]]     case upgradeDocumentLosslessly (v 13) document of