seihou-cli 0.10.0.0 → 0.10.1.0

raw patch · 14 files changed

+359/−31 lines, 14 filesdep ~seihou-corePVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependency ranges changed: seihou-core

API changes (from Hackage documentation)

Files

• help/update.md +12/−0
• seihou-cli.cabal +4/−4
• src-exe/Seihou/CLI/Commands.hs +7/−1
• src-exe/Seihou/CLI/Sync.hs +1/−3
• src/Seihou/CLI/CheckoutSync.hs +69/−1
• src/Seihou/CLI/StatusRender.hs +18/−7
• src/Seihou/CLI/Update.hs +51/−14
• src/Seihou/CLI/Update/Render.hs +5/−0
• src/Seihou/CLI/Update/Types.hs +2/−0
• test/Seihou/CLI/CheckoutSyncE2ESpec.hs +133/−1
• test/Seihou/CLI/CheckoutSyncSpec.hs +8/−0
• test/Seihou/CLI/StatusSpec.hs +27/−0
• test/Seihou/CLI/UpdateFixture.hs +1/−0
• test/Seihou/CLI/UpdateSpec.hs +21/−0

@@ -16,6 +16,18 @@      seihou update master-plan +  No separate installation is needed for an existing remote-backed application:+  update fetches its remote and dependencies and reuses saved inputs. Review the+  preview and accept it. After adoption, fresh clones restore declared links with:++    seihou sync++  An `Adopt link:` preview means update will stop tracking an unchanged matching+  symlink in Git while keeping the working link. Accepting stages that removal;+  commit it with the manifest. Modified or staged links and regular objects remain+  protected. Dry-run/cancellation leave the index untouched; failed or interrupted+  uncommitted updates recover the adopted entries without replacing unrelated staging.+   Apply every recorded application in manifest order:      seihou update

@@ -1,6 +1,6 @@ cabal-version: 3.0 name: seihou-cli-version: 0.10.0.0+version: 0.10.1.0 synopsis: CLI for Seihou project scaffolding description:   Command-line interface for Seihou, a composable project scaffolding@@ -135,7 +135,7 @@     generic-lens >=2.2 && <3,     lens >=5.2 && <6,     process >=1.6 && <2,-    seihou-core ^>=0.10.0.0,+    seihou-core ^>=0.10.1.0,     streamly-core >=0.3 && <0.5,     temporary >=1.3 && <2,     text >=2.0 && <3,@@ -222,7 +222,7 @@     optparse-applicative >=0.18 && <1,     process >=1.6 && <2,     seihou-cli-internal,-    seihou-core ^>=0.10.0.0,+    seihou-core ^>=0.10.1.0,     temporary >=1.3 && <2,     text >=2.0 && <3,     time >=1.12 && <2,@@ -312,7 +312,7 @@     lens >=5.2 && <6,     process >=1.6 && <2,     seihou-cli-internal,-    seihou-core ^>=0.10.0.0,+    seihou-core ^>=0.10.1.0,     streamly-core >=0.3 && <0.5,     tasty >=1.4 && <2,     tasty-hspec >=1.2 && <2,

@@ -2371,7 +2371,13 @@       )  syncInfo :: ParserInfo Command-syncInfo = info (syncParser <**> helper) (fullDesc <> progDesc "Rebuild ignored checkout outputs from the manifest")+syncInfo =+  info+    (syncParser <**> helper)+    ( fullDesc+        <> progDesc "Restore declared local links for this checkout"+        <> footer "Run at the Git working-tree root. No producer installation is needed. If links have not been declared yet, run seihou update TARGET once and commit the resulting manifest; later clones need only seihou sync."+    )   where     syncParser =       Sync

@@ -25,7 +25,5 @@       if opts ^. #json         then LBS.putStrLn (A.encode (checkoutReportJSON report))         else do-          TIO.putStr (renderCheckoutPlan (opts ^. #dryRun) (report ^. #plan))-          mapM_ TIO.putStrLn (report ^. #notices)-          mapM_ (TIO.putStrLn . (^. #message)) (report ^. #execution . #failure)+          TIO.putStr (renderCheckoutReport report)       if not (checkoutApplicable (report ^. #plan)) || isJust (report ^. #execution . #failure) then exitFailure else pure ()

@@ -3,6 +3,8 @@     runCheckoutSync,     checkoutReportJSON,     renderCheckoutPlan,+    renderCheckoutReport,+    checkoutAdoptionNotices,     renderCheckoutStatus,     checkoutFailureJSON,   )@@ -15,6 +17,7 @@ import Data.Map.Strict qualified as Map import Data.Text qualified as T import Data.Text.Encoding qualified as TE+import Seihou.CLI.ApplicationDisplay (appliedTargetName) import Seihou.Core.Checkout import Seihou.Core.Types import Seihou.Effect.Filesystem hiding (CreateDirectoryLink)@@ -56,12 +59,31 @@                   Left err -> pure (Left err)                   Right plan -> do                     execution <- if dryRun then pure (CheckoutExecution Map.empty [] Nothing) else applyCheckoutPlan SyncIgnoredOnly root plan-                    let notices = ["No checkout declarations. Apply a declaring module release once before future clones can use seihou sync." | Map.null (manifest ^. #checkoutOutputs)]+                    let notices = checkoutAdoptionNotices manifest                     pure (Right (CheckoutSyncResult root dryRun plan execution notices))   pure $ case result of     Left err -> Left (checkoutError "checkout_io_failed" ("cannot inspect checkout: " <> T.pack (displayException err)))     Right value -> value +-- | Suggest a check of recorded targets, without claiming that their remotes+-- necessarily contain a declaring release or inferring intent from receipts.+checkoutAdoptionNotices :: Manifest -> [Text]+checkoutAdoptionNotices manifest+  | not (Map.null (manifest ^. #checkoutOutputs)) = []+  | null (manifest ^. #applications) =+      ["No links are declared in this manifest. Apply a module that declares checkout links, then commit its manifest and source files."]+  | otherwise =+      [ "No links are declared in this manifest. Sync can restore links after a declaring module update has been adopted.",+        "Check for an update using the recorded target below; review its preview before accepting:"+      ]+        <> map ("  seihou update " <>) targets+        <> ["Commit the adopted manifest and source files. Future clones need only seihou sync; no producer installation is required."]+  where+    targets = Map.keys (Map.fromList [(shellWord (appliedTargetName (app ^. #target)), ()) | app <- manifest ^. #applications])+    shellWord word+      | T.all (\c -> c `elem` ("abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789-_." :: String)) word = word+      | otherwise = "'" <> T.replace "'" "'\\''" word <> "'"+ checkoutFailureJSON :: Bool -> CheckoutError -> A.Value checkoutFailureJSON dryRun err = A.object ["mode" A..= mode dryRun, "outputs" A..= ([] :: [A.Value]), "errors" A..= [errorJSON err], "summary" A..= A.object ["planned" A..= counts [], "applied" A..= counts []]] @@ -141,6 +163,52 @@         <> T.concat ["; " <> warning | warning <- entry ^. #warnings]     | entry <- plan ^. #entries     ]++renderCheckoutReport :: CheckoutSyncResult -> Text+renderCheckoutReport report =+  renderCheckoutPlan (report ^. #dryRun) displayedPlan+    <> summary+    <> T.unlines (report ^. #notices)+    <> T.unlines (map (^. #message) (maybe [] pure (report ^. #execution . #failure)))+  where+    entries = report ^. #plan . #entries+    outcomes = report ^. #execution . #outcomes+    -- A failed or rolled-back apply must never print a proposed create as+    -- though it succeeded. The summary counts successful mutations only.+    displayedPlan =+      if report ^. #dryRun+        then report ^. #plan+        else+          CheckoutPlan+            [ entry+                & #warnings+                %~ (<> [outcome | outcome `notElem` ["applied", "unchanged"]])+                & #action+                .~ (if outcome `elem` ["applied", "unchanged"] then entry ^. #action else RefusedLink)+            | entry <- entries,+              let outcome = Map.findWithDefault "not-applied" (entry ^. #dest) outcomes+            ]+    countAction action =+      T.pack+        ( show+            ( length+                [ ()+                | entry <- entries,+                  entry ^. #action == action,+                  report ^. #dryRun || Map.lookup (entry ^. #dest) outcomes `elem` [Just "applied", Just "unchanged"]+                ]+            )+        )+    summary+      | null entries = ""+      | otherwise =+          (if report ^. #dryRun then "Would sync links: " else "Links: ")+            <> countAction CreateLink+            <> " created, "+            <> countAction ReplaceLink+            <> " repaired, "+            <> countAction UnchangedLink+            <> " unchanged.\n"  renderCheckoutStatus :: CheckoutPlan -> Text renderCheckoutStatus plan =

@@ -21,12 +21,14 @@ import Data.Time.Format (defaultTimeLocale, formatTime) import Seihou.CLI.ApplicationDisplay (appliedTargetName, parentVarsText) import Seihou.CLI.CheckoutSync (renderCheckoutStatus)-import Seihou.CLI.ManifestGuard (ArtifactCheck, summarizeCheck)+import Seihou.CLI.ManifestGuard (ArtifactCheck (..), ArtifactVerdict (..), summarizeCheck) import Seihou.CLI.Style (dim, green, red, yellow) import Seihou.CLI.VersionCompare   ( OutdatedEntry (..),     OutdatedStatus (..),   )+import Seihou.Core.ArtifactIdentity (isMachineLocalOriginUrl)+import Seihou.Core.ArtifactRef (ArtifactRefError (..)) import Seihou.Core.Checkout (CheckoutPlan) import Seihou.Core.Migration (MigrationPlan (..)) import Seihou.Core.Types@@ -37,6 +39,7 @@     AppliedModule (..),     AppliedRecipe (..),     AppliedTarget (..),+    ArtifactOrigin (..),     Manifest (..),     MigrationOutcome (..),     ModuleName (..),@@ -269,12 +272,20 @@ -- text when every artifact is healthy, so the section disappears entirely -- rather than printing a reassuring "0 problems". formatArtifactChecks :: Bool -> [ArtifactCheck] -> Text-formatArtifactChecks color checks = case mapMaybe summarizeCheck checks of-  [] -> ""-  summaries ->-    T.unlines $-      ["", applyColor color yellow "Artifacts that differ from what this project records:"]-        ++ map ("  " <>) summaries+formatArtifactChecks color checks = warnings <> cacheNotice+  where+    summaries = mapMaybe summarizeCheck (filter (not . remoteCacheMiss) checks)+    warnings = case summaries of+      [] -> ""+      _ -> T.unlines (["", applyColor color yellow "Artifacts that differ from what this project records:"] ++ map ("  " <>) summaries)+    missing = length (filter remoteCacheMiss checks)+    cacheNotice+      | missing == 0 = ""+      | otherwise =+          "\n" <> applyColor color dim ("Remote producer cache: " <> T.pack (show missing) <> " not cached locally (optional). Sync needs no producers; update fetches its remote candidates.") <> "\n"+    remoteCacheMiss check = case (check ^. #origin, check ^. #verdict) of+      (RemoteOrigin url _ _, ArtifactUnresolvable (ArtifactNotFoundLocally _ _)) -> not (isMachineLocalOriginUrl url)+      _ -> False  adviceCommand :: ModuleAdvice -> Maybe Text adviceCommand AdviceNone = Nothing

@@ -175,7 +175,7 @@                           checkoutSetup <- planCheckoutUpdate projectRoot base plannedApplications                           case checkoutSetup of                             Left err -> pure (Left err)-                            Right (checkoutCandidate, checkoutPlan) -> do+                            Right (checkoutCandidate, checkoutPlan, checkoutAdoptions) -> do                               evidence <- versionEvidence (request ^. #allowDowngrade) projectRoot catalog selected plannedApplications                               case evidence of                                 Left err -> pure (Left err)@@ -191,7 +191,7 @@                                           <> versionWarnings                                           <> map CheckoutWarning (concatMap (^. #warnings) (checkoutPlan ^. #entries))                                       inputChanges = summarizeInputChanges seedWarnings plannedApplications-                                      transactionTargets = transactionTargetPaths base reconciliation (migrationStage ^. #plans) `Set.union` Set.fromList [entry ^. #dest | entry <- checkoutPlan ^. #entries, entry ^. #action `elem` [CreateLink, ReplaceLink, RetireLink]]+                                      transactionTargets = transactionTargetPaths base reconciliation (migrationStage ^. #plans) `Set.union` Map.keysSet checkoutAdoptions `Set.union` Set.fromList [entry ^. #dest | entry <- checkoutPlan ^. #entries, entry ^. #action `elem` [CreateLink, ReplaceLink, RetireLink]]                                   -- The manifest is observed as it is on disk, before                                   -- any in-memory preparation, so an edit made between                                   -- planning and apply is reported as a stale plan.@@ -221,6 +221,7 @@                                             reconciliation,                                             checkoutPlan,                                             checkoutOutputs = checkoutCandidate ^. #checkoutOutputs,+                                            checkoutAdoptions,                                             commandPlan,                                             candidateArtifacts = usedArtifacts,                                             warnings,@@ -458,8 +459,11 @@       case backupResult of         Left err -> abortUpdate transaction err         Right () -> do+          adopted <- adoptTrackedLinks transaction (plan ^. #checkoutAdoptions)           now <- getCurrentTime-          migrated <- runRealMigrations now (planBaseManifest plan) (plan ^. #migrations)+          migrated <- case adopted of+            Left err -> pure (Left (UpdateTransactionFailed err))+            Right () -> runRealMigrations now (planBaseManifest plan) (plan ^. #migrations)           case migrated of             Left err -> abortUpdate transaction err             Right migratedManifest -> do@@ -836,10 +840,9 @@      -- The manifest records no path, so the already-applied artifact has to be     -- located from its recorded origin before its content can be hashed. A-    -- resolution failure keeps the existing conservative behaviour of treating-    -- the artifact as changed: this produces an advisory warning, not a-    -- correctness gate. Aborting on a stale or missing artifact is the job of-    -- docs/plans/78-refuse-accidental-module-downgrades-and-origin-mismatches.md.+    -- missing installed copy supplies no evidence of a same-version change.+    -- Reconciliation still compares candidate output with project baselines;+    -- absent cache bytes must not manufacture a content-change warning.     compareArtifact name fromVersion toVersion oldOrigin kind = do       searchPaths <- defaultSearchPaths       resolved <- resolveArtifactOrigin projectRoot searchPaths (definitionFileFor kind) oldOrigin@@ -849,7 +852,7 @@       let candidateHash = (^. #contentHash) <$> Map.lookup (kind, name) (catalog ^. #artifacts)           changed = case (oldHashResult, candidateHash) of             (Right oldHash, Just newHash) -> oldHash /= newHash-            _ -> True+            _ -> False       pure         ( Right             VersionChange@@ -991,6 +994,9 @@  stalePlanPaths :: UpdatePlan -> IO (Set FilePath) stalePlanPaths plan = do+  indexChecks <- forM (Map.toAscList (plan ^. #checkoutAdoptions)) $ \(path, oid) -> do+    current <- trackedLinkIdentity (plan ^. #snapshot . #projectRoot) path+    pure [path | current /= Just oid]   currentProject <-     observePaths       (plan ^. #snapshot . #projectRoot)@@ -1003,7 +1009,7 @@   let projectChanges =         Map.keysSet           (Map.filterWithKey (\path observed -> Map.lookup path currentProject /= Just observed) (plan ^. #snapshot . #observedProjectHashes))-  pure (Set.union projectChanges (Set.fromList (concat candidateChecks)))+  pure (Set.union projectChanges (Set.fromList (concat candidateChecks <> concat indexChecks)))  planActualReconciliation :: UpdatePlan -> Manifest -> IO (Either UpdateError ReconciliationPlan) planActualReconciliation plan manifest = do@@ -1311,6 +1317,7 @@                   skippedDisabled = summary ^. #skippedDisabled                 },             touchedPaths = touched,+            adoptedLinks = Map.keys (plan ^. #checkoutAdoptions),             warnings = plan ^. #warnings <> cleanupWarnings <> pruneWarnings           }     )@@ -1353,6 +1360,7 @@       fileSummary = reconciliationSummary (plan ^. #reconciliation),       commandSummary = CommandSummary 0 0 0,       touchedPaths = Set.empty,+      adoptedLinks = [],       warnings = plan ^. #warnings     } @@ -1367,6 +1375,7 @@   -- change to applied state that only this update will publish (ADR 0004),   -- so a plan carrying one is never a deliberate no-op (ADR 0007).   plan ^. #checkoutOutputs == plan ^. #snapshot . #originalManifest . #checkoutOutputs+    && Map.null (plan ^. #checkoutAdoptions)     && all ((== UnchangedLink) . (^. #action)) (plan ^. #checkoutPlan . #entries)     && isNothing (plan ^. #manifestPreparation)     && null (plan ^. #versionChanges)@@ -1420,16 +1429,44 @@ varValueToText (VInt value) = T.pack (show value) varValueToText (VList values) = T.intercalate "," (map varValueToText values) -planCheckoutUpdate :: FilePath -> Manifest -> [PlannedApplication] -> IO (Either UpdateError (Manifest, CheckoutPlan))+planCheckoutUpdate :: FilePath -> Manifest -> [PlannedApplication] -> IO (Either UpdateError (Manifest, CheckoutPlan, Map FilePath Text)) planCheckoutUpdate root prior applications = case replaceCheckoutApplications prior [(app ^. #candidate, app ^. #operations) | app <- applications] of   Left err -> pure (Left (UpdateCheckoutFailed err))   Right candidate -> do     planned <- runEff $ runFilesystem $ runProcessIO $ prepareCheckoutApplication root prior candidate (concatMap (^. #operations) applications)+    adoptions <- case planned of+      Left _ -> pure Map.empty+      Right plan -> fmap Map.fromList $ fmap concat $ forM (plan ^. #entries) $ \entry ->+        if eligible entry+          then do+            identity <- trackedLinkIdentity root (entry ^. #dest)+            pure [(entry ^. #dest, oid) | Just oid <- [identity]]+          else pure []     pure $ do-      plan <- first UpdateCheckoutFailed planned-      case concatMap (^. #errors) (plan ^. #entries) of-        err : _ -> Left (UpdateCheckoutFailed err)-        [] -> Right (candidate, plan)+      original <- first UpdateCheckoutFailed planned+      let observations =+            Map.fromList+              [ ( entry ^. #dest,+                  if Map.member (entry ^. #dest) adoptions+                    then entry ^. #observation & #problems %~ filter ((/= "checkout_path_tracked") . (^. #code))+                    else entry ^. #observation+                )+              | entry <- original ^. #entries+              ]+          plan = planCheckoutOutputs Reconcile ApplyDeclaration (prior ^. #checkoutOutputs) (candidate ^. #checkoutOutputs) observations+      case [(entry ^. #dest, err) | entry <- plan ^. #entries, err <- entry ^. #errors] of+        (path, err) : _ -> Left (UpdateCheckoutFailed (err & #message %~ (("checkout link '" <> T.pack path <> "': ") <>)))+        [] -> Right (candidate, plan, adoptions)+  where+    eligible entry =+      entry ^. #previous == Nothing+        && entry ^. #observation . #ignored+        && entry ^. #observation . #sourceDirectory+        && not (null (entry ^. #observation . #problems))+        && all ((== "checkout_path_tracked") . (^. #code)) (entry ^. #observation . #problems)+        && case entry ^. #candidate of+          Just spec -> entry ^. #observation . #entry == EntrySymlink (expectedTarget (entry ^. #dest) spec)+          Nothing -> False  applyUpdateCheckout :: UpdatePlan -> Manifest -> Manifest -> IO (Either UpdateError ()) applyUpdateCheckout plan prior filesManifest = runEff $ runFilesystem $ runProcessIO $ do

@@ -125,6 +125,7 @@            renderCommands (summarizeCommandPlan (plan ^. #commandPlan))          ]       <> T.lines (renderCheckoutPlan True (plan ^. #checkoutPlan))+      <> ["Adopt link: " <> T.pack path <> " (stop tracking in Git; keep working link)" | path <- Map.keys (plan ^. #checkoutAdoptions)]       <> conflictLines (plan ^. #reconciliation)       <> warningLines (plan ^. #warnings) renderUpdateHuman _ (UpdateAppliedOutput (UpdateResultView result)) =@@ -139,6 +140,7 @@         <> count (result ^. #commandSummary . #skippedDisabled)         <> " disabled"     ]+      <> ["Adopted " <> count (length (result ^. #adoptedLinks)) <> " link(s): Git removals staged; working links kept. Commit with the updated manifest." | not (null (result ^. #adoptedLinks))]       <> warningLines (result ^. #warnings) renderUpdateHuman _ (UpdateFailedOutput (UpdateErrorView target err)) =   "Update failed [" <> errorCode err <> "]: " <> errorMessage err <> "\n" <> agentUpgradeHint target@@ -158,6 +160,7 @@       "inputs" .= inputValue (plan ^. #inputChanges),       "migrations" .= map migrationValue (plan ^. #migrations),       "checkout" .= checkoutReportJSON (CheckoutSyncResult (plan ^. #snapshot . #projectRoot) True (plan ^. #checkoutPlan) (CheckoutExecution Map.empty [] Nothing) []),+      "checkoutAdoptions" .= Map.keys (plan ^. #checkoutAdoptions),       "files" .= map fileValue (Map.toAscList (plan ^. #reconciliation . #files)),       "commands" .= map commandValue (plan ^. #commandPlan . #commands),       "warnings" .= map warningText (plan ^. #warnings)@@ -176,6 +179,7 @@             "skippedDisabled" .= (result ^. #commandSummary . #skippedDisabled)           ],       "touchedPaths" .= Set.toAscList (result ^. #touchedPaths),+      "adoptedLinks" .= (result ^. #adoptedLinks),       "warnings" .= map warningText (result ^. #warnings)     ] outputValue (UpdateFailedOutput (UpdateErrorView _ err)) =@@ -734,6 +738,7 @@ planLooksUnchanged :: UpdatePlan -> Bool planLooksUnchanged plan =   plan ^. #checkoutOutputs == plan ^. #snapshot . #originalManifest . #checkoutOutputs+    && Map.null (plan ^. #checkoutAdoptions)     && all ((== UnchangedLink) . (^. #action)) (plan ^. #checkoutPlan . #entries)     && isNothing (plan ^. #manifestPreparation)     && null (plan ^. #versionChanges)

@@ -211,6 +211,7 @@     reconciliation :: !ReconciliationPlan,     checkoutPlan :: !CheckoutPlan,     checkoutOutputs :: !(Map FilePath CheckoutOutputRecord),+    checkoutAdoptions :: !(Map FilePath Text),     commandPlan :: !CommandPlan,     candidateArtifacts :: ![CandidateArtifact],     warnings :: ![UpdateWarning],@@ -235,6 +236,7 @@     fileSummary :: !ReconciliationSummary,     commandSummary :: !CommandSummary,     touchedPaths :: !(Set FilePath),+    adoptedLinks :: ![FilePath],     warnings :: ![UpdateWarning]   }   deriving stock (Eq, Generic, Show)

@@ -7,6 +7,7 @@ import Data.ByteString.Lazy qualified as LBS import Data.List (isInfixOf) import Data.Text qualified as T+import Data.Text.Encoding qualified as TE import Data.Text.IO qualified as TIO import Seihou.CLI.SeihouBinary (seihouBinary) import System.Directory qualified as D@@ -35,7 +36,14 @@  snapshot root = do   names <- filter (not . null) . splitNul <$> git root ["ls-files", "-z"]-  blobs <- mapM (\path -> (path,) <$> BS.readFile (root </> path)) names+  blobs <-+    mapM+      ( \path -> do+          linked <- D.pathIsSymbolicLink (root </> path)+          bytes <- if linked then TE.encodeUtf8 . T.pack <$> D.getSymbolicLinkTarget (root </> path) else BS.readFile (root </> path)+          pure (path, bytes)+      )+      names   index <- git root ["ls-files", "--stage", "-z"]   pure (blobs, index)   where@@ -76,8 +84,132 @@   _ <- git root ["commit", "-qm", "test: record checkout output declarations"]   pure (binary, moduleDir) +-- Establish a real old command-producing application, then publish a declaring+-- release. Adoption itself runs in a different, empty personal configuration.+prepareAdoption temp failing = do+  binary <- seihouBinary+  cwd <- D.getCurrentDirectory+  schema <- D.canonicalizePath (takeDirectory cwd </> "schema")+  let root = temp </> "project"+      remote = temp </> "producer"+      initialHome = temp </> "initial-home"+      home = temp </> "empty-home"+      remoteUrl = "https://seihou-fixture.invalid/demo.git"+      moduleBody version steps commands =+        T.unlines+          [ "let S = ./schema/package.dhall in S.Module::{name = \"demo\", version = Some \"" <> version <> "\",",+            "steps = " <> steps <> ", commands = " <> commands <> "}"+          ]+      commit repo message = do+        _ <- git repo ["add", "."]+        git repo ["-c", "user.name=Test", "-c", "user.email=test@example.invalid", "commit", "-qm", message]+  forM_ [root </> "config/editor", remote </> "schema", initialHome, home] (D.createDirectoryIfMissing True)+  -- Keep the recorded origin portable while Git routes this fixture remote to+  -- disk. The adoption home has Git configuration but no producer cache.+  forM_ [initialHome, home] $ \gitHome -> do+    _ <- git gitHome ["config", "--file", gitHome </> ".gitconfig", "url." <> remote <> ".insteadOf", remoteUrl]+    pure ()+  files <- D.listDirectory schema+  forM_ files $ \file -> if takeExtension file == ".dhall" then D.copyFile (schema </> file) (remote </> "schema" </> file) else pure ()+  TIO.writeFile+    (remote </> "module.dhall")+    ( moduleBody+        "1.0.0"+        "[] : List S.Step.Type"+        "[S.Command::{run = \"mkdir -p .local && ln -s ../config/editor .local/config\"}]"+    )+  _ <- git remote ["init", "-q"]+  _ <- commit remote "test: publish command producer"+  _ <- git root ["init", "-q"]+  TIO.writeFile (root </> ".gitignore") ".local/\n.seihou/transactions/\n"+  TIO.writeFile (root </> "config/editor/sentinel") "tracked source\n"+  TIO.writeFile (root </> "unrelated") "committed\n"+  _ <- success binary root initialHome ["install", remoteUrl]+  _ <- success binary root initialHome ["run", "demo", "--force"]+  D.createDirectoryLink "../config/editor" (root </> ".local/unrelated")+  _ <- git root ["add", "-f", ".local/config", ".local/unrelated"]+  _ <- commit root "test: record legacy application and discovery links"+  let commands = if failing then "[S.Command::{run = \"exit 42\"}]" else "[] : List S.Command.Type"+  TIO.writeFile+    (remote </> "module.dhall")+    ( moduleBody+        "2.0.0"+        "[S.Step::{strategy = \"symlink\", lifecycle = Some \"checkout\", src = \"config/editor\", dest = \".local/config\"}]"+        commands+    )+  _ <- commit remote "test: publish checkout declarations"+  pure (binary, root, home)+ tests :: IO TestTree tests = testSpec "manifest-only checkout sync" $ do+  it "adopts a tracked link using remote update alone, then syncs a fresh clone" $+    withSystemTempDirectory "checkout-adoption" $ \temp -> do+      (binary, root, home) <- prepareAdoption temp False+      D.doesDirectoryExist (home </> "config/seihou/installed") `shouldReturn` False+      notice <- success binary root home ["sync"]+      notice `shouldSatisfy` isInfixOf "seihou update demo"+      TIO.writeFile (root </> "unrelated") "staged edit\n"+      _ <- git root ["add", "unrelated"]+      TIO.writeFile (root </> "unrelated") "unstaged edit\n"+      indexBefore <- git root ["ls-files", "--stage", "-z"]+      manifestBefore <- BS.readFile (root </> ".seihou/manifest.json")+      dry <- success binary root home ["update", "demo", "--dry-run"]+      dry `shouldSatisfy` isInfixOf "Adopt link: .local/config"+      git root ["ls-files", "--stage", "-z"] `shouldReturn` indexBefore+      BS.readFile (root </> ".seihou/manifest.json") `shouldReturn` manifestBefore+      _ <- success binary root home ["update", "demo"]+      git root ["ls-files", "--stage", "-z"] `shouldReturn` indexBefore+      BS.readFile (root </> ".seihou/manifest.json") `shouldReturn` manifestBefore+      applied <- success binary root home ["update", "demo", "--json"]+      applied `shouldSatisfy` isInfixOf "\"adoptedLinks\":[\".local/config\"]"+      git root ["ls-files", "--", ".local/config"] `shouldReturn` ""+      git root ["ls-files", "--", ".local/unrelated"] `shouldReturn` ".local/unrelated\n"+      git root ["show", ":unrelated"] `shouldReturn` "staged edit\n"+      TIO.readFile (root </> "unrelated") `shouldReturn` "unstaged edit\n"+      D.getSymbolicLinkTarget (root </> ".local/config") `shouldReturn` "../config/editor"+      _ <- git root ["add", ".seihou/manifest.json"]+      _ <- git root ["-c", "user.name=Test", "-c", "user.email=test@example.invalid", "commit", "-qm", "test: adopt links"]+      let clone = temp </> "clone"; cloneHome = temp </> "clone-home"+      D.createDirectoryIfMissing True cloneHome+      _ <- git root ["clone", "-q", root, clone]+      before <- snapshot clone+      D.doesPathExist (clone </> ".local/config") `shouldReturn` False+      first <- success binary clone cloneHome ["sync"]+      first `shouldSatisfy` isInfixOf "Links: 1 created, 0 repaired, 0 unchanged."+      second <- success binary clone cloneHome ["sync"]+      second `shouldSatisfy` isInfixOf "Links: 0 created, 0 repaired, 1 unchanged."+      status <- success binary clone cloneHome ["status"]+      status `shouldSatisfy` isInfixOf "Checkout outputs: 1 declared, 0 need attention."+      status `shouldSatisfy` isInfixOf "Remote producer cache: 1 not cached locally (optional)"+      status `shouldNotSatisfy` isInfixOf "Artifacts that differ"+      snapshot clone `shouldReturn` before+      D.doesDirectoryExist (cloneHome </> "config/seihou/installed") `shouldReturn` False+  it "restores the original index and working links if an adopted update fails" $+    withSystemTempDirectory "checkout-adoption-failed" $ \temp -> do+      (binary, root, home) <- prepareAdoption temp True+      before <- snapshot root+      (code, _, _) <- invoke binary root home ["update", "demo", "--json"]+      code `shouldSatisfy` (/= ExitSuccess)+      snapshot root `shouldReturn` before+  forM_ ["staged link", "unstaged link", "regular file"] $ \kind ->+    it ("protects a " <> kind <> " during adoption") $+      withSystemTempDirectory "checkout-adoption-refused" $ \temp -> do+        (binary, root, home) <- prepareAdoption temp False+        D.removeDirectoryLink (root </> ".local/config")+        if kind == "regular file"+          then TIO.writeFile (root </> ".local/config") "user bytes"+          else D.createDirectoryLink "../other-target" (root </> ".local/config")+        if kind == "staged link"+          then do+            _ <- git root ["add", "-f", ".local/config"]+            -- The working link matches the new declaration, but the index does not.+            D.removeDirectoryLink (root </> ".local/config")+            D.createDirectoryLink "../config/editor" (root </> ".local/config")+          else pure ()+        before <- snapshot root+        (code, _, _) <- invoke binary root home ["update", "demo", "--json"]+        code `shouldSatisfy` (/= ExitSuccess)+        snapshot root `shouldReturn` before   forM_ [("agent", "agents/skills/demo", ".claude/skills/demo", "agents/skills/demo", ".agents/skills/demo"), ("editor and assets", "config/editor", ".editor-local/config", "assets/shared", ".tool-local/assets")] $ \(domain, source, destination, secondSource, secondDestination) ->     it ("restores " <> domain <> " links in a clean clone without a producer or commands") $       withSystemTempDirectory "checkout-clone" $ \temp -> do

@@ -36,6 +36,14 @@     mapM_ (\action -> renderCheckoutPlan True (CheckoutPlan [entry action]) `shouldSatisfy` (not . T.null)) actions     let report = checkoutReportJSON (result False (CheckoutPlan [entry CreateLink]) (Map.singleton ".local/config" "rolled-back"))     T.pack (show report) `shouldSatisfy` T.isInfixOf "rolled-back"+  it "never counts a failed or rolled-back mutation as a created link" $ do+    let rendered = renderCheckoutReport (result False (CheckoutPlan [entry CreateLink]) (Map.singleton ".local/config" "rolled-back"))+    rendered `shouldSatisfy` T.isInfixOf "0 created"+    rendered `shouldSatisfy` T.isInfixOf "rolled-back"+    rendered `shouldNotSatisfy` T.isInfixOf "1 created"+  it "summarizes proposed dry-run work without claiming writes" $ do+    renderCheckoutReport (result True (CheckoutPlan [entry CreateLink]) Map.empty)+      `shouldSatisfy` T.isInfixOf "Would sync links: 1 created"   it "bounds status to ten sorted paths and supplies the sync remedy" $ do     let entries = [entry CreateLink & #dest .~ ("path-" <> show n) | n <- [1 :: Int .. 12]]         rendered = renderCheckoutStatus (CheckoutPlan entries)

@@ -19,6 +19,7 @@   ( OutdatedEntry (..),     OutdatedStatus (..),   )+import Seihou.Core.ArtifactRef (ArtifactRefError (..)) import Seihou.Core.Migration   ( Migration (..),     MigrationOp (..),@@ -481,3 +482,29 @@             }     formatArtifactChecks False [check] `shouldBe` ""     formatArtifactChecks False [] `shouldBe` ""++  it "treats an empty remote producer cache as optional rather than project damage" $ do+    let origin = RemoteOrigin "https://example.com/demo.git" "demo" Nothing+        missing = ArtifactCheck (ModuleName "demo") origin (ArtifactUnresolvable (ArtifactNotFoundLocally origin []))+        out = formatArtifactChecks False [missing]+    out `shouldSatisfy` T.isInfixOf "Remote producer cache: 1 not cached locally (optional)"+    out `shouldSatisfy` T.isInfixOf "Sync needs no producers; update fetches its remote candidates."+    out `shouldNotSatisfy` T.isInfixOf "Artifacts that differ"+    out `shouldNotSatisfy` T.isInfixOf "not installed"+    let stale = ArtifactCheck (ModuleName "other") origin (ArtifactStale "2.0.0" "1.0.0")+        mixed = formatArtifactChecks False [missing, stale]+    mixed `shouldSatisfy` T.isInfixOf "other: this project expects 2.0.0"+    mixed `shouldSatisfy` T.isInfixOf "Remote producer cache: 1"++  it "keeps missing project-owned and machine-local producers visible as problems" $ do+    let projectOrigin = ProjectOrigin "modules/demo"+        localOrigin = RemoteOrigin "/Users/alice/demo" "local" Nothing+        checks =+          [ ArtifactCheck (ModuleName "demo") projectOrigin (ArtifactUnresolvable (ProjectArtifactMissing projectOrigin "/project/modules/demo")),+            ArtifactCheck (ModuleName "local") localOrigin (ArtifactUnresolvable (ArtifactNotFoundLocally localOrigin []))+          ]+        out = formatArtifactChecks False checks+    out `shouldSatisfy` T.isInfixOf "Artifacts that differ"+    out `shouldSatisfy` T.isInfixOf "demo:"+    out `shouldSatisfy` T.isInfixOf "seihou manifest repair-origins"+    out `shouldNotSatisfy` T.isInfixOf "Remote producer cache"

@@ -54,6 +54,7 @@       reconciliation,       checkoutPlan = CheckoutPlan [],       checkoutOutputs = Map.empty,+      checkoutAdoptions = Map.empty,       commandPlan = CommandPlan [],       candidateArtifacts = [],       warnings = [],

@@ -403,6 +403,26 @@                 (plan ^. #versionChanges) `shouldSatisfy` any (^. #sameVersionContentChanged)                 (plan ^. #warnings) `shouldContain` [SameVersionContentChanged "demo"] +    it "does not invent same-version content changes when the producer cache is empty" $+      withSystemTempDirectory "seihou-update-empty-cache" $ \root -> do+        fixture <- prepareUpdateFixture root+        let modulePath = fixture ^. #remote </> "module.dhall"+        body <- TIO.readFile modulePath+        TIO.writeFile modulePath (T.replace "Some \"2.0.0\"" "Some \"1.0.0\"" body)+        callProcess "git" ["-C", fixture ^. #remote, "add", "module.dhall"]+        callProcess "git" ["-C", fixture ^. #remote, "-c", "user.name=Test", "-c", "user.email=test@example.invalid", "commit", "-qm", "test: same-version candidate"]+        withSavedEnv "XDG_CONFIG_HOME" (Just (root </> "empty-config")) $+          withCurrentDirectory (fixture ^. #projectRoot) $ do+            withProjectUpdate (updateRequest False) $ \case+              Left err -> expectationFailure (show err)+              Right plan -> do+                (plan ^. #warnings) `shouldNotContain` [SameVersionContentChanged "demo"]+                (plan ^. #versionChanges) `shouldNotSatisfy` any (^. #sameVersionContentChanged)+                isUpdateNoOp plan `shouldBe` False+                applied <- applyProjectUpdate plan+                applied `shouldSatisfy` \case Right {} -> True; _ -> False+            TIO.readFile (fixture ^. #projectFile) `shouldReturn` "hello accepted\nkeep\nv2\n"+     it "re-expands a candidate recipe and removes dependencies dropped by it" $       withSystemTempDirectory "seihou-update-recipe" $ \root -> do         fixture <- prepareRecipeUpdateFixture root@@ -1242,6 +1262,7 @@       plannedApplications = plan ^. #plannedApplications,       checkoutPlan = plan ^. #checkoutPlan,       checkoutOutputs = plan ^. #checkoutOutputs,+      checkoutAdoptions = plan ^. #checkoutAdoptions,       manifestPreparation = plan ^. #manifestPreparation     }   where