ReconcileSpec.hs

module Seihou.Engine.ReconcileSpec (tests) where

import Control.Lens ((^.))
import Control.Monad (forM_)
import Data.Functor.Identity (Identity (..))
import Data.Generics.Labels ()
import Data.Map.Strict qualified as Map
import Data.Set qualified as Set
import Data.Text (Text)
import Data.Time (UTCTime, defaultTimeLocale, parseTimeOrError)
import Seihou.Core.Types hiding (KeepCurrent)
import Seihou.Effect.BaselineStore (BaselineError (..))
import Seihou.Engine.Reconcile
import Seihou.Engine.ThreeWayMerge (MergeOutcome (..))
import Seihou.Manifest.Hash (baselineRefForContent, hashContent)
import Seihou.Manifest.Types (emptyManifest)
import Test.Hspec
import Test.Tasty
import Test.Tasty.Hspec (testSpec)

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

spec :: Spec
spec = do
  describe "exact reconciliation drift" $ do
    it "names changed observations and output even when summary counts are equal" $ do
      let desired = DesiredFile "README.md" "new" "owner" Template Set.empty False
          state = PlannedFileState "new" "new" (hashContent "new") True
          planned = ReconciliationPlan Set.empty (Map.singleton "README.md" (FileUpdate desired state (ObservedFile True (Just (hashContent "old"))) Nothing)) Set.empty
          actual = ReconciliationPlan Set.empty (Map.singleton "README.md" (FileUpdate desired (PlannedFileState "new" "new with user edit" (hashContent "new with user edit") True) (ObservedFile True (Just (hashContent "old with user edit"))) Nothing)) Set.empty
      reconciliationSummary planned `shouldBe` reconciliationSummary actual
      reconciliationDifferences planned actual `shouldBe` Map.singleton "README.md" ["observed content", "planned output"]
  describe "materialization" $ do
    it "folds four ordered patches into one desired file" $ do
      let operations =
            [ patch "one" "mod-a",
              patch "two" "mod-b",
              patch "two" "mod-c",
              patch "three" "mod-d"
            ]
          result = planWith (Map.singleton ".gitignore" "root\n") Map.empty Map.empty empty [appA] operations (owners ".gitignore" [appA]) cleanMerge
      case result of
        Right reconciliation -> do
          Map.size (reconciliation ^. #files) `shouldBe` 1
          case (reconciliation ^. #files) Map.! ".gitignore" of
            FileUpdate desired _ _ _ -> (desired ^. #generatedContent) `shouldBe` "root\none\ntwo\nthree\n"
            other -> expectationFailure ("expected one update, got " <> show other)
        Left err -> expectationFailure (show err)

    it "adds newly declared ignore lines without conflicting with user appends or restoring deleted old lines" $ do
      let base = ".claude/\n.agents/\n"
          current = ".claude/\n.mina/\n# user rules\ndist-newstyle/\n"
          ref = baselineRefForContent base
          manifest = withFile ".gitignore" (record base (Just ref) [appA]) empty
          operations = [patch ".claude/\n.agents/\n.codex/" "owner"]
          result = planWith (Map.singleton ".gitignore" current) Map.empty (Map.singleton ref base) manifest [appA] operations (owners ".gitignore" [appA]) (\_ _ _ -> error "line additions must not invoke diff3")
      case result of
        Right reconciliation -> case (reconciliation ^. #files) Map.! ".gitignore" of
          FileAutoMerge _ state _ _ -> do
            state ^. #appliedContent `shouldBe` current <> ".codex/\n"
            state ^. #generatedBaseline `shouldBe` base <> ".codex/\n"
          other -> expectationFailure (show other)
        Left err -> expectationFailure (show err)

    it "replays a patch after a complete write" $ do
      let operations =
            [ WriteFileOp "README.md" "generated\n" Template,
              PatchFileOp "README.md" "added\n" AppendFile Template "mod-b"
            ]
          result = planWith Map.empty Map.empty Map.empty empty [appA] operations (owners "README.md" [appA]) cleanMerge
      case result of
        Right reconciliation -> case (reconciliation ^. #files) Map.! "README.md" of
          FileCreate desired _ _ -> (desired ^. #generatedContent) `shouldBe` "generated\nadded\n"
          other -> expectationFailure ("expected create, got " <> show other)
        Left err -> expectationFailure (show err)

    it "materializes copy operations through the supplied source reader" $ do
      let operations = [CopyFileOp "/staged/template" "copied.txt"]
          result =
            planWith
              Map.empty
              (Map.singleton "/staged/template" "copied\n")
              Map.empty
              empty
              [appA]
              operations
              (owners "copied.txt" [appA])
              cleanMerge
      case result of
        Right reconciliation -> case (reconciliation ^. #files) Map.! "copied.txt" of
          FileCreate desired _ _ -> do
            (desired ^. #generatedContent) `shouldBe` "copied\n"
            (desired ^. #strategy) `shouldBe` Copy
          other -> expectationFailure ("expected create, got " <> show other)
        Left err -> expectationFailure (show err)

  describe "baseline trust and application scoping" $ do
    it "adopts a legacy disk baseline only when its recorded hash matches" $ do
      let manifest = withFile "legacy.txt" (record "legacy\n" Nothing [appA]) empty
          result =
            planWith
              (Map.singleton "legacy.txt" "legacy\n")
              Map.empty
              Map.empty
              manifest
              [appA]
              [WriteFileOp "legacy.txt" "new\n" Template]
              (owners "legacy.txt" [appA])
              cleanMerge
      case result of
        Right reconciliation -> case (reconciliation ^. #files) Map.! "legacy.txt" of
          FileUpdate _ _ _ _ -> pure ()
          other -> expectationFailure ("expected trusted update, got " <> show other)
        Left err -> expectationFailure (show err)

    it "refuses to guess a legacy baseline after a user edit" $ do
      let manifest = withFile "legacy.txt" (record "legacy\n" Nothing [appA]) empty
          result =
            planWith
              (Map.singleton "legacy.txt" "user edit\n")
              Map.empty
              Map.empty
              manifest
              [appA]
              [WriteFileOp "legacy.txt" "new\n" Template]
              (owners "legacy.txt" [appA])
              cleanMerge
      case result of
        Right reconciliation -> case (reconciliation ^. #files) Map.! "legacy.txt" of
          FileConflict _ current _ MissingTrustedBaseline _ _ Nothing -> current `shouldBe` "user edit\n"
          other -> expectationFailure ("expected conservative conflict, got " <> show other)
        Left err -> expectationFailure (show err)

    it "reports every owner when a targeted update regenerates a shared path" $ do
      let manifest = withFile "shared.txt" (record "old\n" Nothing [appA, appB]) empty
          result =
            planWith
              (Map.singleton "shared.txt" "old\n")
              Map.empty
              Map.empty
              manifest
              [appA]
              [WriteFileOp "shared.txt" "new\n" Template]
              (owners "shared.txt" [appA])
              cleanMerge
      result `shouldBe` Left (SharedPathRequiresApplications "shared.txt" (Set.fromList [appA, appB]))

    it "rejects a newly colliding path owned only by an unselected application" $ do
      let manifest = withFile "shared.txt" (record "old\n" Nothing [appB]) empty
          result =
            planWith
              (Map.singleton "shared.txt" "old\n")
              Map.empty
              Map.empty
              manifest
              [appA]
              [WriteFileOp "shared.txt" "new\n" Template]
              (owners "shared.txt" [appA])
              cleanMerge
      result `shouldBe` Left (SharedPathRequiresApplications "shared.txt" (Set.singleton appB))

    it "lets a targeted update through an additive-only shared path" $ do
      -- Replaying appA's append on top of the trusted baseline leaves appB's
      -- lines where they were, so the closure has nothing to protect here.
      let baseline = baselineRefForContent "/dist\n/result\n"
          prior = additiveRecord "/dist\n/result\n" (Just baseline) [appA, appB]
          manifest = withFile ".gitignore" prior empty
          result =
            planWith
              (Map.singleton ".gitignore" "/dist\n/result\n")
              Map.empty
              (Map.singleton baseline "/dist\n/result\n")
              manifest
              [appA]
              [patch "/dist-newstyle" "mod-a"]
              (owners ".gitignore" [appA])
              cleanMerge
      case result of
        Left err -> expectationFailure ("expected the plan to be accepted, got " <> show err)
        Right reconciliation -> do
          Map.keys (reconciliation ^. #files) `shouldBe` [".gitignore"]
          case (reconciliation ^. #files) Map.! ".gitignore" of
            FileUpdate desired _ _ _ -> do
              -- appB's line survives the replay byte for byte.
              (desired ^. #generatedContent) `shouldBe` "/dist\n/result\n/dist-newstyle\n"
              (desired ^. #additiveOnly) `shouldBe` True
            other -> expectationFailure ("expected a file update, got " <> show other)

    it "refuses an additive-only shared path when the candidate writes the whole file" $ do
      -- The manifest still says additive, but this module's new version
      -- replaced its patch step with a whole-file step. The candidate's own
      -- operations settle it, before anything is written.
      let baseline = baselineRefForContent "/dist\n/result\n"
          prior = additiveRecord "/dist\n/result\n" (Just baseline) [appA, appB]
          manifest = withFile ".gitignore" prior empty
          result =
            planWith
              (Map.singleton ".gitignore" "/dist\n/result\n")
              Map.empty
              (Map.singleton baseline "/dist\n/result\n")
              manifest
              [appA]
              [WriteFileOp ".gitignore" "/dist-newstyle\n" Template]
              (owners ".gitignore" [appA])
              cleanMerge
      result `shouldBe` Left (SharedPathRequiresApplications ".gitignore" (Set.fromList [appA, appB]))

    it "refuses an additive-only shared path when the candidate adds a position-dependent patch" $ do
      let baseline = baselineRefForContent "/dist\n/result\n"
          prior = additiveRecord "/dist\n/result\n" (Just baseline) [appA, appB]
          manifest = withFile ".gitignore" prior empty
          result =
            planWith
              (Map.singleton ".gitignore" "/dist\n/result\n")
              Map.empty
              (Map.singleton baseline "/dist\n/result\n")
              manifest
              [appA]
              [ patch "/dist-newstyle" "mod-a",
                PatchFileOp ".gitignore" "/tail\n" AppendFile Template "mod-a"
              ]
              (owners ".gitignore" [appA])
              cleanMerge
      result `shouldBe` Left (SharedPathRequiresApplications ".gitignore" (Set.fromList [appA, appB]))

    it "refuses a shared path the manifest does not record as additive-only" $ do
      -- A manifest written before the field existed reads as False, and must
      -- keep requiring every owner regardless of how additive this run is.
      let baseline = baselineRefForContent "/dist\n/result\n"
          prior = record "/dist\n/result\n" (Just baseline) [appA, appB]
          manifest = withFile ".gitignore" prior empty
          result =
            planWith
              (Map.singleton ".gitignore" "/dist\n/result\n")
              Map.empty
              (Map.singleton baseline "/dist\n/result\n")
              manifest
              [appA]
              [patch "/dist-newstyle" "mod-a"]
              (owners ".gitignore" [appA])
              cleanMerge
      result `shouldBe` Left (SharedPathRequiresApplications ".gitignore" (Set.fromList [appA, appB]))

    it "rejects control paths before reading or planning" $ do
      let result =
            planWith
              Map.empty
              Map.empty
              Map.empty
              empty
              [appA]
              [WriteFileOp ".seihou/manifest.json" "bad" Template]
              (owners ".seihou/manifest.json" [appA])
              cleanMerge
      result `shouldSatisfy` isInvalidPath

    it "rejects Seihou's own state, the .seihou directory as a file, and Git data" $
      forM_ [".seihou/baselines/x", ".SEIHOU/manifest.json", ".seihou", ".git/config"] $ \path ->
        planWith Map.empty Map.empty Map.empty empty [appA] [WriteFileOp path "bad" Template] (owners path [appA]) cleanMerge
          `shouldSatisfy` isInvalidPath

    it "rejects a directory operand inside Seihou's own state" $
      planWith Map.empty Map.empty Map.empty empty [appA] [CreateDirOp ".seihou/baselines"] Map.empty cleanMerge
        `shouldSatisfy` isInvalidPath

    it "plans a write into a module's own .seihou directory with its parent directories" $ do
      let path = ".seihou/demo/helper.txt"
          operations = [CreateDirOp ".seihou", CreateDirOp ".seihou/demo", WriteFileOp path "top\nmiddle v1\nbottom\n" Template]
      case planWith Map.empty Map.empty Map.empty empty [appA] operations (owners path [appA]) cleanMerge of
        Right reconciliation -> Map.member path (reconciliation ^. #files) `shouldBe` True
        Left err -> expectationFailure (show err)

    it "merges a user edit in a module's own .seihou directory like any managed file" $ do
      let path = ".seihou/demo/helper.txt"
          base = "top\nmiddle v1\nbottom\n"
          ref = baselineRefForContent base
          manifest = withFile path (record base (Just ref) [appA]) empty
          result =
            planWith
              (Map.singleton path "top edited by user\nmiddle v1\nbottom\n")
              Map.empty
              (Map.singleton ref base)
              manifest
              [appA]
              [CreateDirOp ".seihou", CreateDirOp ".seihou/demo", WriteFileOp path "top\nmiddle v2\nbottom\n" Template]
              (owners path [appA])
              (\_ _ _ -> MergeClean "top edited by user\nmiddle v2\nbottom\n")
      case result of
        Right reconciliation -> case (reconciliation ^. #files) Map.! path of
          FileAutoMerge _ state _ _ -> (state ^. #appliedContent) `shouldBe` "top edited by user\nmiddle v2\nbottom\n"
          other -> expectationFailure ("expected automatic merge, got " <> show other)
        Left err -> expectationFailure (show err)

  describe "classification and resolution" $ do
    it "preserves a user-only edit without advancing its applied hash" $ do
      let base = "base\n"
          ref = baselineRefForContent base
          oldRecord = record base (Just ref) [appA]
          manifest = withFile "file.txt" oldRecord empty
          result =
            planWith
              (Map.singleton "file.txt" "user\n")
              Map.empty
              (Map.singleton ref base)
              manifest
              [appA]
              [WriteFileOp "file.txt" base Template]
              (owners "file.txt" [appA])
              cleanMerge
      case result of
        Right reconciliation -> case (reconciliation ^. #files) Map.! "file.txt" of
          FileUnchanged _ state _ _ -> do
            (state ^. #appliedContent) `shouldBe` "user\n"
            (state ^. #recordedHash) `shouldBe` (oldRecord ^. #hash)
            (state ^. #writeToDisk) `shouldBe` False
          other -> expectationFailure ("expected unchanged user edit, got " <> show other)
        Left err -> expectationFailure (show err)

    it "classifies a clean dual edit as one automatic merge" $ do
      let base = "base\n"
          ref = baselineRefForContent base
          manifest = withFile "file.txt" (record base (Just ref) [appA]) empty
          result =
            planWith
              (Map.singleton "file.txt" "user\n")
              Map.empty
              (Map.singleton ref base)
              manifest
              [appA]
              [WriteFileOp "file.txt" "generated\n" Template]
              (owners "file.txt" [appA])
              (\_ _ _ -> MergeClean "user and generated\n")
      case result of
        Right reconciliation -> do
          case (reconciliation ^. #files) Map.! "file.txt" of
            FileAutoMerge _ state _ _ -> (state ^. #appliedContent) `shouldBe` "user and generated\n"
            other -> expectationFailure ("expected automatic merge, got " <> show other)
          reconciliationSummary reconciliation `shouldBe` ReconciliationSummary 0 0 1 0 0 0 0 0
        Left err -> expectationFailure (show err)

    it "keeps overlapping edits unresolved until an explicit choice" $ do
      let base = "base\n"
          ref = baselineRefForContent base
          markers = "<<<<<<< current\nuser\n=======\ngenerated\n>>>>>>> new-generated\n"
          manifest = withFile "file.txt" (record base (Just ref) [appA]) empty
          planned =
            planWith
              (Map.singleton "file.txt" "user\n")
              Map.empty
              (Map.singleton ref base)
              manifest
              [appA]
              [WriteFileOp "file.txt" "generated\n" Template]
              (owners "file.txt" [appA])
              (\_ _ _ -> MergeConflicted markers)
      case planned of
        Left err -> expectationFailure (show err)
        Right reconciliation -> do
          unresolvedPaths reconciliation `shouldBe` Set.singleton "file.txt"
          let resolved = resolveFileConflict "file.txt" KeepCurrent reconciliation
          case resolved of
            Left err -> expectationFailure (show err)
            Right finalPlan -> case (finalPlan ^. #files) Map.! "file.txt" of
              FileConflict _ _ _ _ _ _ (Just resolution) -> do
                (resolution ^. #state . #generatedBaseline) `shouldBe` "generated\n"
                (resolution ^. #state . #appliedContent) `shouldBe` "user\n"
                unresolvedPaths finalPlan `shouldBe` Set.empty
              other -> expectationFailure ("expected resolved conflict, got " <> show other)

  describe "orphan handling" $ do
    it "distinguishes safe deletion, edited retention, and shared release" $ do
      let manifest =
            withFile "safe.txt" (record "safe\n" Nothing [appA]) $
              withFile "edited.txt" (record "before\n" Nothing [appA]) $
                withFile "shared.txt" (record "shared\n" Nothing [appA, appB]) empty
          disk =
            Map.fromList
              [ ("safe.txt", "safe\n"),
                ("edited.txt", "user\n"),
                ("shared.txt", "shared\n")
              ]
          result = planWith disk Map.empty Map.empty manifest [appA] [] Map.empty cleanMerge
      case result of
        Left err -> expectationFailure (show err)
        Right reconciliation -> do
          (reconciliation ^. #files) Map.! "safe.txt" `shouldSatisfy` isSafeDelete
          (reconciliation ^. #files) Map.! "edited.txt" `shouldSatisfy` isEditedOrphan
          (reconciliation ^. #files) Map.! "shared.txt" `shouldSatisfy` isSharedRelease
          unresolvedPaths reconciliation `shouldBe` Set.singleton "edited.txt"
          case resolveEditedOrphan "edited.txt" RetainTrackedOrphan reconciliation of
            Left err -> expectationFailure (show err)
            Right resolved -> unresolvedPaths resolved `shouldBe` Set.empty

fixedTime :: UTCTime
fixedTime = parseTimeOrError True defaultTimeLocale "%Y-%m-%dT%H:%M:%SZ" "2026-07-19T12:00:00Z"

appA, appB :: ApplicationId
appA = ApplicationId "app-a"
appB = ApplicationId "app-b"

empty :: Manifest
empty = emptyManifest fixedTime

withFile :: FilePath -> FileRecord -> Manifest -> Manifest
withFile path fileRecord manifest =
  Manifest
    { version = manifest ^. #version,
      genAt = manifest ^. #genAt,
      modules = manifest ^. #modules,
      vars = manifest ^. #vars,
      files = Map.insert path fileRecord (manifest ^. #files),
      applications = manifest ^. #applications,
      recipe = manifest ^. #recipe,
      blueprint = manifest ^. #blueprint,
      seeds = manifest ^. #seeds,
      checkoutOutputs = manifest ^. #checkoutOutputs,
      blueprintMigrations = manifest ^. #blueprintMigrations,
      judgements = manifest ^. #judgements
    }

record :: Text -> Maybe BaselineRef -> [ApplicationId] -> FileRecord
record content baseline owners' =
  FileRecord
    { hash = hashContent content,
      moduleName = "owner",
      strategy = Template,
      generatedAt = fixedTime,
      baseline = baseline,
      applicationIds = Set.fromList owners',
      sharedWriteMode = SharedWriteUnknown
    }

-- | A record for a path every owner reaches through an additive patch.
additiveRecord :: Text -> Maybe BaselineRef -> [ApplicationId] -> FileRecord
additiveRecord content baseline owners' =
  FileRecord
    { hash = hashContent content,
      moduleName = "owner",
      strategy = Template,
      generatedAt = fixedTime,
      baseline = baseline,
      applicationIds = Set.fromList owners',
      sharedWriteMode = SharedWriteAdditiveOnly
    }

owners :: FilePath -> [ApplicationId] -> Map.Map FilePath DesiredFileOwner
owners path ownerIds = Map.singleton path (DesiredFileOwner "owner" (Set.fromList ownerIds))

patch :: Text -> ModuleName -> Operation
patch content moduleName = PatchFileOp ".gitignore" (content <> "\n") AppendLineIfAbsent Template moduleName

cleanMerge :: Text -> Text -> Text -> MergeOutcome
cleanMerge _ _ generated = MergeClean generated

planWith ::
  Map.Map FilePath Text ->
  Map.Map FilePath Text ->
  Map.Map BaselineRef Text ->
  Manifest ->
  [ApplicationId] ->
  [Operation] ->
  Map.Map FilePath DesiredFileOwner ->
  (Text -> Text -> Text -> MergeOutcome) ->
  Either ReconciliationError ReconciliationPlan
planWith disk copySources baselines manifest selected operations ownerMap merge =
  runIdentity $
    planReconciliationWith
      (pure . (`Map.lookup` disk))
      (\path -> pure (maybe (Left (CopySourceUnavailable path)) Right (Map.lookup path copySources)))
      (\ref -> pure (maybe (Left (BaselineMissing ref)) Right (Map.lookup ref baselines)))
      (\base current generated -> pure (merge base current generated))
      manifest
      (Set.fromList selected)
      operations
      ownerMap

isInvalidPath :: Either ReconciliationError ReconciliationPlan -> Bool
isInvalidPath (Left (InvalidReconciliationPath _ _)) = True
isInvalidPath _ = False

isSafeDelete :: FileReconciliation -> Bool
isSafeDelete (FileDeleteSafe _ _ _) = True
isSafeDelete _ = False

isEditedOrphan :: FileReconciliation -> Bool
isEditedOrphan (FileOrphanEdited _ _ _ _ _) = True
isEditedOrphan _ = False

isSharedRelease :: FileReconciliation -> Bool
isSharedRelease (FileReleaseSharedOwnership _ _ _) = True
isSharedRelease _ = False