packages feed

seihou-cli-0.11.0.0: test/Seihou/CLI/SeedUpdateE2ESpec.hs

module Seihou.CLI.SeedUpdateE2ESpec (tests) where

import Control.Monad (forM_, when)
import Data.ByteString qualified as BS
import Data.Generics.Labels ()
import Data.Map.Strict qualified as Map
import Data.Text qualified as T
import Data.Text.IO qualified as TIO
import Seihou.CLI.SeedRunE2ESpec (body, invoke, prepare, readManifest, success)
import Seihou.Core.Types
import Seihou.Prelude
import System.Directory qualified as D
import System.Exit (ExitCode (..))
import System.IO.Temp (withSystemTempDirectory)
import System.Process (callProcess, readProcess)
import Test.Hspec
import Test.Tasty
import Test.Tasty.Hspec (testSpec)

candidate modul lifecycle = TIO.writeFile (modul </> "module.dhall") (T.replace "1.0.0" "2.0.0" (body lifecycle ""))

tests :: IO TestTree
tests = testSpec "seed update end-to-end" $ do
  it "auto-commits creations and the manifest without staging edits to released files" $
    withSystemTempDirectory "seed-update-commit" $ \root -> do
      (binary, modul) <- prepare root
      TIO.writeFile (modul </> "module.dhall") (body "managed" "")
      _ <- success binary root ["run", "demo"]
      callProcess "git" ["-C", root, "init", "-q"]
      callProcess "git" ["-C", root, "config", "user.name", "Seihou Test"]
      callProcess "git" ["-C", root, "config", "user.email", "test@example.com"]
      callProcess "git" ["-C", root, "add", "."]
      callProcess "git" ["-C", root, "commit", "-qm", "test: record managed fixture"]
      TIO.writeFile (root </> "nested/start.txt") "uncommitted project edit\n"
      TIO.writeFile (modul </> "module.dhall") (T.replace "1.0.0" "2.0.0" (T.replace ",S.Step::{strategy=\"copy\",src=\"license\",dest=\"LICENSE\"}" ",S.Step::{strategy=\"copy\",src=\"starter\",dest=\"new.txt\",lifecycle=Some \"seed\"},S.Step::{strategy=\"copy\",src=\"license\",dest=\"LICENSE\"}" (body "seed" "")))
      _ <- success binary root ["update", "demo", "--json", "--commit-message", "chore: adopt seeds"]
      committed <- lines <$> readProcess "git" ["-C", root, "show", "--pretty=", "--name-only", "HEAD"] ""
      committed `shouldContain` [".seihou/manifest.json", "new.txt"]
      committed `shouldNotContain` ["nested/start.txt"]
      TIO.readFile (root </> "nested/start.txt") `shouldReturn` "uncommitted project edit\n"

  it "releases managed edits, absence and replacement directories without touching project state" $
    forM_ ["edited", "missing", "directory"] $ \state -> withSystemTempDirectory "seed-update-release" $ \root -> do
      (binary, modul) <- prepare root
      TIO.writeFile (modul </> "module.dhall") (body "managed" "")
      _ <- success binary root ["run", "demo"]
      case state of
        "edited" -> TIO.writeFile (root </> "nested/start.txt") "project edit\n"
        "missing" -> D.removeFile (root </> "nested/start.txt")
        _ -> D.removeFile (root </> "nested/start.txt") >> D.createDirectory (root </> "nested/start.txt")
      candidate modul "seed"
      before <- BS.readFile (root </> ".seihou/manifest.json")
      preview <- success binary root ["update", "demo", "--dry-run"]
      preview `shouldSatisfy` T.isInfixOf "release to project nested/start.txt"
      BS.readFile (root </> ".seihou/manifest.json") `shouldReturn` before
      _ <- success binary root ["update", "demo", "--json"]
      applied <- readManifest root
      Map.member "nested/start.txt" (applied ^. #files) `shouldBe` False
      fmap (^. #outcome) (Map.lookup "nested/start.txt" (applied ^. #seeds)) `shouldBe` Just SeedReleasedFromManaged
      case state of
        "edited" -> TIO.readFile (root </> "nested/start.txt") `shouldReturn` "project edit\n"
        "missing" -> D.doesPathExist (root </> "nested/start.txt") `shouldReturn` False
        _ -> D.doesDirectoryExist (root </> "nested/start.txt") `shouldReturn` True
      after <- BS.readFile (root </> ".seihou/manifest.json")
      repeated <- success binary root ["update", "demo", "--json"]
      repeated `shouldSatisfy` T.isInfixOf "\"alreadyUpToDate\":true"
      BS.readFile (root </> ".seihou/manifest.json") `shouldReturn` after

  it "creates newly introduced seeds once and preserves deliberate deletion on repeat" $
    withSystemTempDirectory "seed-update-create" $ \root -> do
      (binary, modul) <- prepare root
      let empty = "let S = ./schema/package.dhall in S.Module::{name=\"demo\",version=Some \"1.0.0\"}"
      TIO.writeFile (modul </> "module.dhall") empty
      _ <- success binary root ["run", "demo"]
      candidate modul "seed"
      _ <- success binary root ["update", "demo", "--json"]
      TIO.readFile (root </> "nested/start.txt") `shouldReturn` "starter\n"
      D.removeFile (root </> "nested/start.txt")
      D.removeDirectory (root </> "nested")
      _ <- success binary root ["update", "demo", "--force", "--json"]
      D.doesPathExist (root </> "nested") `shouldReturn` False

  it "retires disappearing claims and seeds an absent path after reintroduction" $
    withSystemTempDirectory "seed-update-retire" $ \root -> do
      (binary, modul) <- prepare root
      _ <- success binary root ["run", "demo"]
      TIO.writeFile (root </> "nested/start.txt") "mine\n"
      TIO.writeFile (modul </> "module.dhall") "let S = ./schema/package.dhall in S.Module::{name=\"demo\",version=Some \"2.0.0\"}"
      _ <- success binary root ["update", "demo", "--json"]
      retired <- readManifest root
      retired ^. #seeds `shouldBe` Map.empty
      TIO.readFile (root </> "nested/start.txt") `shouldReturn` "mine\n"
      D.removeFile (root </> "nested/start.txt")
      TIO.writeFile (modul </> "module.dhall") (T.replace "1.0.0" "3.0.0" (body "seed" ""))
      _ <- success binary root ["update", "demo", "--json"]
      TIO.readFile (root </> "nested/start.txt") `shouldReturn` "starter\n"

  it "requires explicit adoption even for equal bytes, and force or JSON cannot consent" $
    forM_ [False, True] $ \missing -> withSystemTempDirectory "seed-update-adopt" $ \root -> do
      (binary, modul) <- prepare root
      _ <- success binary root ["run", "demo"]
      when missing (D.removeFile (root </> "nested/start.txt"))
      candidate modul "managed"
      before <- BS.readFile (root </> ".seihou/manifest.json")
      forM_ [["--json"], ["--force", "--json"]] $ \flags -> do
        (code, out, _) <- invoke binary root (["update", "demo"] <> flags)
        code `shouldBe` ExitFailure 1
        T.pack out `shouldSatisfy` T.isInfixOf "seed_adoption_requires_interaction"
        BS.readFile (root </> ".seihou/manifest.json") `shouldReturn` before
      D.doesFileExist (root </> "nested/start.txt") `shouldReturn` not missing

  it "rejects mixed candidate lifecycles after expanding shared managed owners" $
    withSystemTempDirectory "seed-update-shared" $ \root -> do
      (binary, modul) <- prepare root
      TIO.writeFile (modul </> "module.dhall") (body "managed" "")
      _ <- success binary root ["run", "demo"]
      let other = root </> ".seihou/modules/other"
      D.createDirectoryIfMissing True (other </> "files")
      D.copyFile (modul </> "files/starter") (other </> "files/starter")
      D.copyFile (modul </> "files/license") (other </> "files/license")
      TIO.writeFile (other </> "module.dhall") (T.replace "./schema/package.dhall" "../demo/schema/package.dhall" (T.replace "name=\"demo\"" "name=\"other\"" (body "managed" "")))
      _ <- success binary root ["run", "other", "--force"]
      candidate modul "seed"
      before <- BS.readFile (root </> ".seihou/manifest.json")
      forM_ [[], ["--include-shared-owners"]] $ \flags -> do
        (code, _, _) <- invoke binary root (["update", "demo", "--json"] <> flags)
        code `shouldBe` ExitFailure 1
        BS.readFile (root </> ".seihou/manifest.json") `shouldReturn` before
      TIO.readFile (root </> "nested/start.txt") `shouldReturn` "starter\n"