packages feed

seihou-core-0.4.0.0: test/Seihou/Engine/RemoveSpec.hs

module Seihou.Engine.RemoveSpec (tests) where

import Data.Map.Strict qualified as Map
import Data.Set qualified as Set
import Data.Text (Text)
import Data.Time (UTCTime, defaultTimeLocale, parseTimeOrError)
import Effectful
import Seihou.Core.Types
import Seihou.Effect.FilesystemPure (PureFS (..), emptyFS, runFilesystemPure)
import Seihou.Engine.Remove
import Seihou.Manifest.Hash (hashContent)
import Seihou.Manifest.Types (emptyManifest)
import Test.Hspec
import Test.Tasty
import Test.Tasty.Hspec (testSpec)

tests :: IO TestTree
tests = testSpec "Seihou.Engine.Remove" spec

fixedTime :: UTCTime
fixedTime = parseTimeOrError True defaultTimeLocale "%Y-%m-%dT%H:%M:%SZ" "2026-03-01T10:30:00Z"

removeTime :: UTCTime
removeTime = parseTimeOrError True defaultTimeLocale "%Y-%m-%dT%H:%M:%SZ" "2026-03-02T09:00:00Z"

modName :: ModuleName
modName = ModuleName "test-module"

otherMod :: ModuleName
otherMod = ModuleName "other-module"

-- | Helper: create a manifest with one applied module and some files.
mkManifest :: Bool -> [(FilePath, Text)] -> Manifest
mkManifest isRemovable fileContents =
  (emptyManifest fixedTime)
    { modules =
        [ AppliedModule
            { name = modName,
              parentVars = emptyParentVars,
              source = "/path/to/test-module",
              moduleVersion = Nothing,
              appliedAt = fixedTime,
              removal = if isRemovable then Just (Removal [] []) else Nothing
            }
        ],
      files =
        Map.fromList
          [ ( path,
              FileRecord
                { hash = hashContent content,
                  moduleName = modName,
                  strategy = Template,
                  generatedAt = fixedTime
                }
            )
          | (path, content) <- fileContents
          ]
    }

-- | Helper: create a manifest with a specific removal spec.
mkManifestWithRemoval :: Removal -> [(FilePath, Text)] -> Manifest
mkManifestWithRemoval removal fileContents =
  (emptyManifest fixedTime)
    { modules =
        [ AppliedModule
            { name = modName,
              source = "/path/to/test-module",
              moduleVersion = Nothing,
              appliedAt = fixedTime,
              removal = Just removal
            }
        ],
      files =
        Map.fromList
          [ ( path,
              FileRecord
                { hash = hashContent content,
                  moduleName = modName,
                  strategy = Template,
                  generatedAt = fixedTime
                }
            )
          | (path, content) <- fileContents
          ]
    }

-- | Helper: create a PureFS with files.
mkFS :: [(FilePath, Text)] -> PureFS
mkFS fileContents = PureFS (Map.fromList fileContents) Set.empty

-- | Run computeRemovalPlan in the pure filesystem.
runPlan :: PureFS -> Manifest -> ModuleName -> Either RemovalError RemovalPlan
runPlan fs manifest name =
  fst $ runPureEff $ runFilesystemPure fs $ computeRemovalPlan manifest name

-- | Run executeRemoval in the pure filesystem.
runExec :: PureFS -> Manifest -> RemovalPlan -> Set.Set FilePath -> (Manifest, PureFS)
runExec fs manifest plan keepSet =
  let (result, finalFS) =
        runPureEff $
          runFilesystemPure fs $
            executeRemoval manifest plan keepSet removeTime
   in (result, finalFS)

-- | Run buildRemovalOps in the pure filesystem.
runBuildOps :: PureFS -> Manifest -> ModuleName -> Removal -> Either RemovalError ExecutedRemovalPlan
runBuildOps fs manifest name removal =
  fst $ runPureEff $ runFilesystemPure fs $ buildRemovalOps manifest name removal

-- | Run executeRemovalOps in the pure filesystem.
runExecOps :: PureFS -> Manifest -> ExecutedRemovalPlan -> Set.Set FilePath -> (Manifest, PureFS)
runExecOps fs manifest plan keepSet =
  let (result, finalFS) =
        runPureEff $
          runFilesystemPure fs $
            executeRemovalOps manifest plan keepSet removeTime
   in (result, finalFS)

spec :: Spec
spec = do
  describe "computeRemovalPlan" $ do
    it "returns ModuleNotApplied when module is not in manifest" $ do
      let manifest = emptyManifest fixedTime
          result = runPlan emptyFS manifest modName
      result `shouldBe` Left (ModuleNotApplied modName)

    it "returns ModuleNotRemovable when removal is Nothing" $ do
      let manifest = mkManifest False [("README.md", "hello")]
          fs = mkFS [("README.md", "hello")]
          result = runPlan fs manifest modName
      result `shouldBe` Left (ModuleNotRemovable modName)

    it "classifies unchanged files as RemovalSafe" $ do
      let manifest = mkManifest True [("README.md", "hello")]
          fs = mkFS [("README.md", "hello")]
          result = runPlan fs manifest modName
      case result of
        Left err -> expectationFailure ("unexpected error: " <> show err)
        Right plan -> plan.files `shouldBe` [RemovalSafe "README.md"]

    it "classifies user-modified files as RemovalConflict" $ do
      let manifest = mkManifest True [("README.md", "original")]
          fs = mkFS [("README.md", "user changed this")]
          result = runPlan fs manifest modName
      case result of
        Left err -> expectationFailure ("unexpected error: " <> show err)
        Right plan -> plan.files `shouldBe` [RemovalConflict "README.md"]

    it "classifies deleted files as RemovalGone" $ do
      let manifest = mkManifest True [("README.md", "hello")]
          result = runPlan emptyFS manifest modName
      case result of
        Left err -> expectationFailure ("unexpected error: " <> show err)
        Right plan -> plan.files `shouldBe` [RemovalGone "README.md"]

    it "handles mix of safe, conflict, and gone files" $ do
      let manifest = mkManifest True [("a.txt", "aaa"), ("b.txt", "bbb"), ("c.txt", "ccc")]
          fs = mkFS [("a.txt", "aaa"), ("b.txt", "modified")]
          result = runPlan fs manifest modName
      case result of
        Left err -> expectationFailure ("unexpected error: " <> show err)
        Right plan -> do
          length plan.files `shouldBe` 3
          RemovalSafe "a.txt" `elem` plan.files `shouldBe` True
          RemovalConflict "b.txt" `elem` plan.files `shouldBe` True
          RemovalGone "c.txt" `elem` plan.files `shouldBe` True

  describe "executeRemoval" $ do
    it "deletes safe files from the filesystem" $ do
      let manifest = mkManifest True [("README.md", "hello")]
          fs = mkFS [("README.md", "hello")]
          plan = RemovalPlan {targetModule = modName, files = [RemovalSafe "README.md"]}
          (_, finalFS) = runExec fs manifest plan Set.empty
      Map.member "README.md" finalFS.files `shouldBe` False

    it "preserves files in the keep-set" $ do
      let manifest = mkManifest True [("a.txt", "aaa")]
          fs = mkFS [("a.txt", "modified")]
          plan = RemovalPlan {targetModule = modName, files = [RemovalConflict "a.txt"]}
          keepSet = Set.singleton "a.txt"
          (_, finalFS) = runExec fs manifest plan keepSet
      Map.member "a.txt" finalFS.files `shouldBe` True

    it "removes the module from manifest.modules" $ do
      let manifest = mkManifest True [("README.md", "hello")]
          fs = mkFS [("README.md", "hello")]
          plan = RemovalPlan {targetModule = modName, files = [RemovalSafe "README.md"]}
          (updated, _) = runExec fs manifest plan Set.empty
      updated.modules `shouldBe` []

    it "removes module's files from manifest.files" $ do
      let manifest = mkManifest True [("a.txt", "aaa"), ("b.txt", "bbb")]
          fs = mkFS [("a.txt", "aaa"), ("b.txt", "bbb")]
          plan = RemovalPlan {targetModule = modName, files = [RemovalSafe "a.txt", RemovalSafe "b.txt"]}
          (updated, _) = runExec fs manifest plan Set.empty
      Map.null updated.files `shouldBe` True

    it "preserves files from other modules in manifest" $ do
      let base = mkManifest True [("mine.txt", "mine")]
          otherRec = FileRecord (hashContent "other") otherMod Template fixedTime
          manifest =
            Manifest
              { version = base.version,
                genAt = base.genAt,
                modules = base.modules,
                vars = base.vars,
                files = Map.insert "other.txt" otherRec base.files
              }
          fs = mkFS [("mine.txt", "mine"), ("other.txt", "other")]
          plan = RemovalPlan {targetModule = modName, files = [RemovalSafe "mine.txt"]}
          (updated, _) = runExec fs manifest plan Set.empty
      Map.member "other.txt" updated.files `shouldBe` True
      Map.member "mine.txt" updated.files `shouldBe` False

    it "updates genAt timestamp in manifest" $ do
      let manifest = mkManifest True [("a.txt", "aaa")]
          fs = mkFS [("a.txt", "aaa")]
          plan = RemovalPlan {targetModule = modName, files = [RemovalSafe "a.txt"]}
          (updated, _) = runExec fs manifest plan Set.empty
      updated.genAt `shouldBe` removeTime

    it "full round-trip: manifest returns to clean state after removal" $ do
      let manifest = mkManifest True [("a.txt", "aaa"), ("b.txt", "bbb")]
          fs = mkFS [("a.txt", "aaa"), ("b.txt", "bbb")]
          plan = RemovalPlan {targetModule = modName, files = [RemovalSafe "a.txt", RemovalSafe "b.txt"]}
          (updated, finalFS) = runExec fs manifest plan Set.empty
      updated.modules `shouldBe` []
      Map.null updated.files `shouldBe` True
      Map.member "a.txt" finalFS.files `shouldBe` False
      Map.member "b.txt" finalFS.files `shouldBe` False

  describe "buildRemovalOps" $ do
    it "returns ModuleNotApplied when module is not in manifest" $ do
      let manifest = emptyManifest fixedTime
          removal = Removal [] []
          result = runBuildOps emptyFS manifest modName removal
      result `shouldBe` Left (ModuleNotApplied modName)

    it "builds DeleteFileOp with RFSafe for unchanged files" $ do
      let removal = Removal [RemovalStep RemoveFileAction "README.md" Nothing] []
          manifest = mkManifestWithRemoval removal [("README.md", "hello")]
          fs = mkFS [("README.md", "hello")]
          result = runBuildOps fs manifest modName removal
      case result of
        Left err -> expectationFailure ("unexpected error: " <> show err)
        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] []
          manifest = mkManifestWithRemoval removal [("README.md", "original")]
          fs = mkFS [("README.md", "user changed this")]
          result = runBuildOps fs manifest modName removal
      case result of
        Left err -> expectationFailure ("unexpected error: " <> show err)
        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] []
          manifest = mkManifestWithRemoval removal [("README.md", "hello")]
          result = runBuildOps emptyFS manifest modName removal
      case result of
        Left err -> expectationFailure ("unexpected error: " <> show err)
        Right plan -> plan.ops `shouldBe` [DeleteFileOp "README.md" RFGone]

    it "builds StripSectionOp for remove-section steps" $ do
      let removal = Removal [RemovalStep RemoveSectionAction ".gitignore" Nothing] []
          manifest = mkManifestWithRemoval removal [(".gitignore", "content")]
          fs = mkFS [(".gitignore", "content")]
          result = runBuildOps fs manifest modName removal
      case result of
        Left err -> expectationFailure ("unexpected error: " <> show err)
        Right plan -> plan.ops `shouldBe` [StripSectionOp ".gitignore"]

    it "builds RemovalCommandOp for removal commands" $ do
      let removal = Removal [] [Command "cabal clean" Nothing Nothing]
          manifest = mkManifestWithRemoval removal []
          result = runBuildOps emptyFS manifest modName removal
      case result of
        Left err -> expectationFailure ("unexpected error: " <> show err)
        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] []
          manifest = mkManifestWithRemoval removal []
          fs = mkFS [("../outside", "do not delete")]
          result = runBuildOps fs manifest modName removal
      result
        `shouldBe` Left
          ( RemovalUnsafePath
              "remove-file destination"
              "../outside"
              "path must not contain '..' segment: ../outside"
          )
      Map.member "../outside" fs.files `shouldBe` True

    it "rejects a removal command workDir with a parent directory segment" $ do
      let removal = Removal [] [Command "echo unsafe" (Just "../outside") Nothing]
          manifest = mkManifestWithRemoval removal []
          result = runBuildOps emptyFS manifest modName removal
      result
        `shouldBe` Left
          ( RemovalUnsafePath
              "remove-command workDir"
              "../outside"
              "path must not contain '..' segment: ../outside"
          )

    it "combines steps and commands in order" $ do
      let removal =
            Removal
              [RemovalStep RemoveFileAction "a.txt" Nothing, RemovalStep RemoveSectionAction ".gitignore" Nothing]
              [Command "echo done" Nothing Nothing]
          manifest = mkManifestWithRemoval removal [("a.txt", "aaa")]
          fs = mkFS [("a.txt", "aaa"), (".gitignore", "stuff")]
          result = runBuildOps fs manifest modName removal
      case result of
        Left err -> expectationFailure ("unexpected error: " <> show err)
        Right plan -> do
          length plan.ops `shouldBe` 3
          case plan.ops of
            [DeleteFileOp _ _, StripSectionOp _, RemovalCommandOp _ _] -> pure ()
            other -> expectationFailure ("unexpected ops: " <> show other)

  describe "executeRemovalOps" $ do
    it "deletes files with DeleteFileOp" $ do
      let removal = Removal [RemovalStep RemoveFileAction "README.md" Nothing] []
          manifest = mkManifestWithRemoval removal [("README.md", "hello")]
          fs = mkFS [("README.md", "hello")]
          plan = ExecutedRemovalPlan modName [DeleteFileOp "README.md" RFSafe]
          (_, finalFS) = runExecOps fs manifest plan Set.empty
      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] []
          manifest = mkManifestWithRemoval removal [("a.txt", "aaa")]
          fs = mkFS [("a.txt", "modified")]
          plan = ExecutedRemovalPlan modName [DeleteFileOp "a.txt" RFConflict]
          keepSet = Set.singleton "a.txt"
          (_, finalFS) = runExecOps fs manifest plan keepSet
      Map.member "a.txt" finalFS.files `shouldBe` True

    it "skips gone files" $ do
      let manifest = mkManifest True [("a.txt", "aaa")]
          plan = ExecutedRemovalPlan modName [DeleteFileOp "a.txt" RFGone]
          (updated, _) = runExecOps emptyFS manifest plan Set.empty
      updated.modules `shouldBe` []

    it "strips section from file with StripSectionOp" $ do
      let content = "before\n# --- seihou:test-module ---\nmodule content\n# --- /seihou:test-module ---\nafter\n"
          manifest = mkManifest True [(".gitignore", content)]
          fs = mkFS [(".gitignore", content)]
          plan = ExecutedRemovalPlan modName [StripSectionOp ".gitignore"]
          (_, finalFS) = runExecOps fs manifest plan Set.empty
      case Map.lookup ".gitignore" finalFS.files of
        Nothing -> expectationFailure ".gitignore should still exist"
        Just result -> do
          result `shouldSatisfy` \t ->
            "before" `elem` lines (show t) || not ("seihou:test-module" `elem` lines (show t))

    it "leaves file unchanged when no section markers found" $ do
      let content = "no markers here\n"
          manifest = mkManifest True [("file.txt", content)]
          fs = mkFS [("file.txt", content)]
          plan = ExecutedRemovalPlan modName [StripSectionOp "file.txt"]
          (_, finalFS) = runExecOps fs manifest plan Set.empty
      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] []
          manifest = mkManifestWithRemoval removal [("a.txt", "aaa")]
          fs = mkFS [("a.txt", "aaa")]
          plan = ExecutedRemovalPlan modName [DeleteFileOp "a.txt" RFSafe]
          (updated, _) = runExecOps fs manifest plan Set.empty
      updated.modules `shouldBe` []
      Map.null updated.files `shouldBe` True

    it "preserves other modules' files in manifest" $ do
      let base = mkManifest True [("mine.txt", "mine")]
          otherRec = FileRecord (hashContent "other") otherMod Template fixedTime
          manifest =
            Manifest
              { version = base.version,
                genAt = base.genAt,
                modules = base.modules,
                vars = base.vars,
                files = Map.insert "other.txt" otherRec base.files
              }
          fs = mkFS [("mine.txt", "mine"), ("other.txt", "other")]
          plan = ExecutedRemovalPlan modName [DeleteFileOp "mine.txt" RFSafe]
          (updated, _) = runExecOps fs manifest plan Set.empty
      Map.member "other.txt" updated.files `shouldBe` True
      Map.member "mine.txt" updated.files `shouldBe` False