ai-agent-diff-patch-0.0.1.0: test/AIAgent/DiffPatch/Unified/ProjectedContext/ContextSpec.hs
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ScopedTypeVariables #-}
-- | Test module for ProjectedContext.Context.
module AIAgent.DiffPatch.Unified.ProjectedContext.ContextSpec (spec) where
import Test.Hspec
import Test.QuickCheck
import Control.Monad (foldM)
import qualified Data.Text as T
import Data.Text (Text)
import AIAgent.DiffPatch.Unified.ProjectedContext.Context
( normalize, lcs, myers, buildHunks, applyHunk
, formatPatch, parsePatch
, generateSearchIndices, applyHunkFuzzy, applyPatchText
)
import AIAgent.DiffPatch.Unified.CoreModel.Type
( Edit(..), Hunk(..), Line(..), LineType(..), PatchError(..)
, Patch(..), FileHeader(..)
)
import AIAgent.DiffPatch.Unified.CoreModel.Constant (_FUZZY_RANGE)
-- | Default context lines for integration tests (test-local constant).
-- This value mirrors the GNU diff -u default and is kept here rather than
-- in CoreModel to avoid polluting the production constant space.
_DEFAULT_CONTEXT :: Int
_DEFAULT_CONTEXT = 3
-- | Run the full ProjectedContext pipeline:
-- normalize -> T.lines -> myers -> buildHunks -> foldM applyHunk -> T.unlines
--
-- Notes on T.lines / T.unlines behaviour:
-- T.lines "a\nb\n" => ["a","b"] (trailing empty element is dropped)
-- T.unlines ["a","b"] => "a\nb\n" (newline appended to every element)
-- T.lines "" => []
-- T.unlines [] => ""
--
-- CRLF input is normalised to LF before processing; the output is therefore
-- always LF-terminated.
runPipeline :: Text -> Text -> Either PatchError Text
runPipeline oldText newText =
let oldLines = T.lines (normalize oldText)
newLines = T.lines (normalize newText)
edits = myers oldLines newLines
hunks = buildHunks _DEFAULT_CONTEXT edits
in fmap T.unlines (foldM applyHunk oldLines hunks)
-- |
spec :: Spec
spec = do
describe "normalize" $ do
it "TC-01: converts CRLF to LF" $
normalize "foo\r\nbar\r\nbaz" `shouldBe` "foo\nbar\nbaz"
it "TC-02: leaves LF-only text unchanged" $
normalize "foo\nbar\nbaz" `shouldBe` "foo\nbar\nbaz"
it "TC-03: converts bare CR to LF" $
normalize "foo\rbar\rbaz" `shouldBe` "foo\nbar\nbaz"
it "TC-04: returns empty text unchanged" $
normalize "" `shouldBe` ""
it "TC-05: handles mixed CRLF, CR, and LF" $
normalize "foo\r\nbar\rbaz\nqux" `shouldBe` "foo\nbar\nbaz\nqux"
it "TC-06: leaves text without newlines unchanged" $
normalize "no newline" `shouldBe` "no newline"
describe "lcs" $ do
it "TC-01: identical lines, all Keep" $
lcs ["a","b","c"] ["a","b","c"]
`shouldBe` [Keep "a", Keep "b", Keep "c"]
it "TC-02: one line changed" $
lcs ["a","b","c"] ["a","x","c"]
`shouldBe` [Keep "a", Delete "b", Insert "x", Keep "c"]
it "TC-03: line appended at end" $
lcs ["a","b","c"] ["a","b","c","d"]
`shouldBe` [Keep "a", Keep "b", Keep "c", Insert "d"]
it "TC-04: first line deleted" $
lcs ["a","b","c"] ["b","c"]
`shouldBe` [Delete "a", Keep "b", Keep "c"]
it "TC-05: old is empty, all Insert" $
lcs [] ["a","b"]
`shouldBe` [Insert "a", Insert "b"]
it "TC-06: new is empty, all Delete" $
lcs ["a","b"] []
`shouldBe` [Delete "a", Delete "b"]
it "TC-07: both empty, empty result" $
lcs [] []
`shouldBe` []
describe "myers" $ do
-- Basic correctness: same expected output as lcs for the canonical cases
it "TC-01: identical lines, all Keep" $
myers ["a","b","c"] ["a","b","c"]
`shouldBe` [Keep "a", Keep "b", Keep "c"]
it "TC-02: one line changed (Delete before Insert)" $
myers ["a","b","c"] ["a","x","c"]
`shouldBe` [Keep "a", Delete "b", Insert "x", Keep "c"]
it "TC-03: line appended at end" $
myers ["a","b","c"] ["a","b","c","d"]
`shouldBe` [Keep "a", Keep "b", Keep "c", Insert "d"]
it "TC-04: first line deleted" $
myers ["a","b","c"] ["b","c"]
`shouldBe` [Delete "a", Keep "b", Keep "c"]
it "TC-05: old is empty, all Insert" $
myers [] ["a","b"]
`shouldBe` [Insert "a", Insert "b"]
it "TC-06: new is empty, all Delete" $
myers ["a","b"] []
`shouldBe` [Delete "a", Delete "b"]
it "TC-07: both empty, empty result" $
myers [] []
`shouldBe` []
-- Additional myers-specific tests
it "TC-08: single identical line" $
myers ["x"] ["x"]
`shouldBe` [Keep "x"]
it "TC-09: single line replaced" $
myers ["x"] ["y"]
`shouldBe` [Delete "x", Insert "y"]
it "TC-10: insert in the middle" $
myers ["a","c"] ["a","b","c"]
`shouldBe` [Keep "a", Insert "b", Keep "c"]
it "TC-11: delete in the middle" $
myers ["a","b","c"] ["a","c"]
`shouldBe` [Keep "a", Delete "b", Keep "c"]
it "TC-12: completely different content" $
myers ["a","b"] ["x","y"]
`shouldBe` [Delete "a", Delete "b", Insert "x", Insert "y"]
it "TC-13: multiple edits spread across lines" $
myers ["a","b","c","d","e"] ["a","x","c","y","e"]
`shouldBe` [ Keep "a"
, Delete "b", Insert "x"
, Keep "c"
, Delete "d", Insert "y"
, Keep "e"
]
it "TC-14: last line deleted" $
myers ["a","b","c"] ["a","b"]
`shouldBe` [Keep "a", Keep "b", Delete "c"]
it "TC-15: prefix shared, suffix differs" $
myers ["a","b","c"] ["a","b","d"]
`shouldBe` [Keep "a", Keep "b", Delete "c", Insert "d"]
it "TC-16: old is a single line, new is multiple" $
myers ["a"] ["a","b","c"]
`shouldBe` [Keep "a", Insert "b", Insert "c"]
it "TC-17: new is a single line, old is multiple" $
myers ["a","b","c"] ["a"]
`shouldBe` [Keep "a", Delete "b", Delete "c"]
it "TC-18: line inserted at beginning" $
myers ["b","c"] ["a","b","c"]
`shouldBe` [Insert "a", Keep "b", Keep "c"]
it "TC-19: first line replaced (Delete before Insert at head)" $
myers ["a","b","c"] ["x","b","c"]
`shouldBe` [Delete "a", Insert "x", Keep "b", Keep "c"]
describe "buildHunks" $ do
-- TC-01: no changes -> no hunks
it "TC-01: no changes, returns empty hunk list" $
buildHunks 3 [Keep "a", Keep "b", Keep "c"]
`shouldBe` []
-- TC-02: one change in the middle, exactly 3 context lines on each side
it "TC-02: one change in the middle with 3 context lines" $
buildHunks 3
[ Keep "1", Keep "2", Keep "3"
, Delete "4", Insert "X"
, Keep "5", Keep "6", Keep "7"
]
`shouldBe`
[ Hunk
{ _oldStartHunk = 1, _oldCountHunk = 7
, _newStartHunk = 1, _newCountHunk = 7
, _linesHunk =
[ Line Context "1", Line Context "2", Line Context "3"
, Line Removed "4", Line Added "X"
, Line Context "5", Line Context "6", Line Context "7"
]
}
]
-- TC-03: change at the beginning (no leading context)
it "TC-03: change at the beginning, no leading context" $
buildHunks 3
[ Delete "1", Insert "X"
, Keep "2", Keep "3", Keep "4"
]
`shouldBe`
[ Hunk
{ _oldStartHunk = 1, _oldCountHunk = 4
, _newStartHunk = 1, _newCountHunk = 4
, _linesHunk =
[ Line Removed "1", Line Added "X"
, Line Context "2", Line Context "3", Line Context "4"
]
}
]
-- TC-04: change at the end (no trailing context)
it "TC-04: change at the end, no trailing context" $
buildHunks 3
[ Keep "1", Keep "2", Keep "3"
, Delete "4", Insert "X"
]
`shouldBe`
[ Hunk
{ _oldStartHunk = 1, _oldCountHunk = 4
, _newStartHunk = 1, _newCountHunk = 4
, _linesHunk =
[ Line Context "1", Line Context "2", Line Context "3"
, Line Removed "4", Line Added "X"
]
}
]
-- TC-05: two change blocks with gap > 2*3=6 keeps -> two separate hunks
it "TC-05: two change blocks far apart become two hunks" $
buildHunks 3
( [ Keep "1", Keep "2", Keep "3"
, Delete "4", Insert "A"
]
++ replicate 8 (Keep "_")
++ [ Delete "13", Insert "B"
, Keep "14", Keep "15", Keep "16"
]
)
`shouldSatisfy` \hs -> length hs == 2
-- TC-06: two change blocks with gap <= 2*3=6 keeps -> merged into one hunk
it "TC-06: two change blocks close together are merged into one hunk" $
buildHunks 3
( [ Keep "1", Keep "2", Keep "3"
, Delete "4", Insert "A"
]
++ replicate 6 (Keep "_")
++ [ Delete "11", Insert "B"
, Keep "12", Keep "13", Keep "14"
]
)
`shouldSatisfy` \hs -> length hs == 1
-- TC-07: context lines = 0
it "TC-07: context lines = 0 produces hunk with no context" $
buildHunks 0
[ Keep "a", Delete "b", Insert "X", Keep "c" ]
`shouldBe`
[ Hunk
{ _oldStartHunk = 2, _oldCountHunk = 1
, _newStartHunk = 2, _newCountHunk = 1
, _linesHunk = [ Line Removed "b", Line Added "X" ]
}
]
-- TC-08: empty edit list -> empty result
it "TC-08: empty edit list returns empty" $
buildHunks 3 []
`shouldBe` []
-- TC-09: all deletions
it "TC-09: all lines deleted, _newCountHunk = 0" $
buildHunks 3 [Delete "a", Delete "b", Delete "c"]
`shouldBe`
[ Hunk
{ _oldStartHunk = 1, _oldCountHunk = 3
, _newStartHunk = 1, _newCountHunk = 0
, _linesHunk = [Line Removed "a", Line Removed "b", Line Removed "c"]
}
]
-- TC-10: all insertions
it "TC-10: all lines inserted, _oldCountHunk = 0" $
buildHunks 3 [Insert "a", Insert "b", Insert "c"]
`shouldBe`
[ Hunk
{ _oldStartHunk = 1, _oldCountHunk = 0
, _newStartHunk = 1, _newCountHunk = 3
, _linesHunk = [Line Added "a", Line Added "b", Line Added "c"]
}
]
-- TC-11: verify 1-based _oldStartHunk and _newStartHunk
it "TC-11: _oldStartHunk and _newStartHunk are 1-based" $
let hunks = buildHunks 0
[ Keep "a", Keep "b", Keep "c"
, Delete "d", Insert "X"
]
in do
length hunks `shouldBe` 1
_oldStartHunk (head hunks) `shouldBe` 4
_newStartHunk (head hunks) `shouldBe` 4
describe "applyHunk" $ do
-- TC-01: normal - replace one line in the middle
it "TC-01: replace one line in the middle" $
let src = ["a", "b", "c", "d", "e"]
hunk = Hunk
{ _oldStartHunk = 2, _oldCountHunk = 3
, _newStartHunk = 2, _newCountHunk = 3
, _linesHunk =
[ Line Context "b"
, Line Removed "c", Line Added "X"
, Line Context "d"
]
}
in applyHunk src hunk `shouldBe` Right ["a", "b", "X", "d", "e"]
-- TC-02: normal - insert one line (pure insertion, no removal)
it "TC-02: insert a line at the end" $
let src = ["a", "b", "c"]
hunk = Hunk
{ _oldStartHunk = 3, _oldCountHunk = 1
, _newStartHunk = 3, _newCountHunk = 2
, _linesHunk =
[ Line Context "c"
, Line Added "d"
]
}
in applyHunk src hunk `shouldBe` Right ["a", "b", "c", "d"]
-- TC-03: normal - delete one line in the middle
it "TC-03: delete one line in the middle" $
let src = ["a", "b", "c"]
hunk = Hunk
{ _oldStartHunk = 1, _oldCountHunk = 3
, _newStartHunk = 1, _newCountHunk = 2
, _linesHunk =
[ Line Context "a"
, Line Removed "b"
, Line Context "c"
]
}
in applyHunk src hunk `shouldBe` Right ["a", "c"]
-- TC-04: normal - replace first line (no leading context)
it "TC-04: replace the first line, no leading context" $
let src = ["a", "b", "c"]
hunk = Hunk
{ _oldStartHunk = 1, _oldCountHunk = 1
, _newStartHunk = 1, _newCountHunk = 1
, _linesHunk = [Line Removed "a", Line Added "X"]
}
in applyHunk src hunk `shouldBe` Right ["X", "b", "c"]
-- TC-05: normal - replace last line (no trailing context)
it "TC-05: replace the last line, no trailing context" $
let src = ["a", "b", "c"]
hunk = Hunk
{ _oldStartHunk = 3, _oldCountHunk = 1
, _newStartHunk = 3, _newCountHunk = 1
, _linesHunk = [Line Removed "c", Line Added "Z"]
}
in applyHunk src hunk `shouldBe` Right ["a", "b", "Z"]
-- TC-06: normal - insert into empty source (_oldCountHunk = 0)
it "TC-06: insert lines into an empty source" $
let src = []
hunk = Hunk
{ _oldStartHunk = 1, _oldCountHunk = 0
, _newStartHunk = 1, _newCountHunk = 2
, _linesHunk = [Line Added "x", Line Added "y"]
}
in applyHunk src hunk `shouldBe` Right ["x", "y"]
-- TC-07: normal - delete all lines (_newCountHunk = 0)
it "TC-07: delete all lines, result is empty" $
let src = ["a", "b", "c"]
hunk = Hunk
{ _oldStartHunk = 1, _oldCountHunk = 3
, _newStartHunk = 1, _newCountHunk = 0
, _linesHunk = [Line Removed "a", Line Removed "b", Line Removed "c"]
}
in applyHunk src hunk `shouldBe` Right []
-- TC-08: error - context line does not match source
it "TC-08: context line mismatch returns HunkMismatch" $
let src = ["a", "b", "c"]
hunk = Hunk
{ _oldStartHunk = 1, _oldCountHunk = 2
, _newStartHunk = 1, _newCountHunk = 2
, _linesHunk =
[ Line Context "a"
, Line Context "WRONG" -- does not match "b"
]
}
in applyHunk src hunk `shouldBe` Left (HunkMismatch 2 "WRONG")
-- TC-09: error - removed line does not match source
it "TC-09: removed line mismatch returns HunkMismatch" $
let src = ["a", "b", "c"]
hunk = Hunk
{ _oldStartHunk = 1, _oldCountHunk = 2
, _newStartHunk = 1, _newCountHunk = 1
, _linesHunk =
[ Line Context "a"
, Line Removed "WRONG" -- does not match "b"
]
}
in applyHunk src hunk `shouldBe` Left (HunkMismatch 2 "WRONG")
-- TC-10: error - _oldStartHunk exceeds source length
it "TC-10: _oldStartHunk beyond source length returns InvalidPatch" $
let src = ["a", "b", "c"]
hunk = Hunk
{ _oldStartHunk = 5, _oldCountHunk = 1
, _newStartHunk = 5, _newCountHunk = 1
, _linesHunk = [Line Removed "x", Line Added "y"]
}
in applyHunk src hunk `shouldSatisfy` \r -> case r of
Left (InvalidPatch _) -> True
_ -> False
-- TC-11: normal - hunk with context lines on both sides
it "TC-11: hunk with 3 context lines on each side applies correctly" $
let src = ["1","2","3","4","5","6","7"]
hunk = Hunk
{ _oldStartHunk = 1, _oldCountHunk = 7
, _newStartHunk = 1, _newCountHunk = 7
, _linesHunk =
[ Line Context "1", Line Context "2", Line Context "3"
, Line Removed "4", Line Added "X"
, Line Context "5", Line Context "6", Line Context "7"
]
}
in applyHunk src hunk `shouldBe` Right ["1","2","3","X","5","6","7"]
describe "formatPatch" $ do
-- FMT-01: header-less, 1 hunk (1-line replacement)
it "FMT-01: header-less patch with one replacement hunk" $
let p = Patch Nothing
[ Hunk 1 1 1 1
[ Line Removed "old"
, Line Added "new"
]
]
in formatPatch p `shouldBe`
"@@ -1,1 +1,1 @@\n-old\n+new\n"
-- FMT-02: with file header, 1 hunk
it "FMT-02: patch with file header" $
let p = Patch (Just (FileHeader "a/file.hs" "b/file.hs"))
[ Hunk 1 1 1 1
[ Line Removed "old"
, Line Added "new"
]
]
in formatPatch p `shouldBe`
"--- a/file.hs\n+++ b/file.hs\n@@ -1,1 +1,1 @@\n-old\n+new\n"
-- FMT-03: hunk with context, removed, and added lines
it "FMT-03: hunk with context, removed, and added lines" $
let p = Patch Nothing
[ Hunk 2 3 2 3
[ Line Context "ctx"
, Line Removed "rem"
, Line Added "add"
]
]
in formatPatch p `shouldBe`
"@@ -2,3 +2,3 @@\n ctx\n-rem\n+add\n"
-- FMT-04: two hunks
it "FMT-04: patch with two hunks" $
let p = Patch Nothing
[ Hunk 1 1 1 1 [Line Removed "a", Line Added "x"]
, Hunk 5 1 5 1 [Line Removed "b", Line Added "y"]
]
in formatPatch p `shouldBe`
"@@ -1,1 +1,1 @@\n-a\n+x\n@@ -5,1 +5,1 @@\n-b\n+y\n"
-- FMT-05: pure insertion hunk (oldCount=0)
it "FMT-05: pure insertion hunk, oldCount=0 is not omitted" $
let p = Patch Nothing
[ Hunk 1 0 1 2
[ Line Added "x"
, Line Added "y"
]
]
in formatPatch p `shouldBe`
"@@ -1,0 +1,2 @@\n+x\n+y\n"
-- FMT-06: pure deletion hunk (newCount=0)
it "FMT-06: pure deletion hunk, newCount=0 is not omitted" $
let p = Patch Nothing
[ Hunk 1 3 1 0
[ Line Removed "a"
, Line Removed "b"
, Line Removed "c"
]
]
in formatPatch p `shouldBe`
"@@ -1,3 +1,0 @@\n-a\n-b\n-c\n"
describe "parsePatch" $ do
-- PSR-01: header-less, 1 hunk (1-line replacement)
it "PSR-01: header-less patch, one replacement hunk" $
parsePatch "@@ -1,1 +1,1 @@\n-old\n+new\n"
`shouldBe`
Right (Patch Nothing
[ Hunk 1 1 1 1
[ Line Removed "old"
, Line Added "new"
]
])
-- PSR-02: with file header, 1 hunk
it "PSR-02: patch with file header" $
parsePatch "--- a/file.hs\n+++ b/file.hs\n@@ -1,1 +1,1 @@\n-old\n+new\n"
`shouldBe`
Right (Patch (Just (FileHeader "a/file.hs" "b/file.hs"))
[ Hunk 1 1 1 1
[ Line Removed "old"
, Line Added "new"
]
])
-- PSR-03: hunk with context, removed, and added lines
it "PSR-03: hunk with context, removed, and added lines" $
parsePatch "@@ -2,3 +2,3 @@\n ctx\n-rem\n+add\n"
`shouldBe`
Right (Patch Nothing
[ Hunk 2 3 2 3
[ Line Context "ctx"
, Line Removed "rem"
, Line Added "add"
]
])
-- PSR-04: two hunks
it "PSR-04: patch with two hunks" $
let result = parsePatch "@@ -1,1 +1,1 @@\n-a\n+x\n@@ -5,1 +5,1 @@\n-b\n+y\n"
in fmap (length . _hunksPatch) result `shouldBe` Right 2
-- PSR-05: omitted oldCount defaults to 1
it "PSR-05: omitted oldCount defaults to 1" $
let result = parsePatch "@@ -1 +1,1 @@\n-a\n+b\n"
in fmap (_oldCountHunk . head . _hunksPatch) result `shouldBe` Right 1
-- PSR-06: omitted newCount defaults to 1
it "PSR-06: omitted newCount defaults to 1" $
let result = parsePatch "@@ -1,1 +1 @@\n-a\n+b\n"
in fmap (_newCountHunk . head . _hunksPatch) result `shouldBe` Right 1
-- PSR-07: _oldCountHunk=0
it "PSR-07: parse _oldCountHunk=0 correctly" $
let result = parsePatch "@@ -1,0 +1,2 @@\n+x\n+y\n"
in fmap (_oldCountHunk . head . _hunksPatch) result `shouldBe` Right 0
-- PSR-08: _newCountHunk=0
it "PSR-08: parse _newCountHunk=0 correctly" $
let result = parsePatch "@@ -1,3 +1,0 @@\n-a\n-b\n-c\n"
in fmap (_newCountHunk . head . _hunksPatch) result `shouldBe` Right 0
-- PSR-09: parse failure (invalid input)
it "PSR-09: invalid input returns InvalidPatch" $
parsePatch "not a patch\n"
`shouldSatisfy` \r -> case r of
Left (InvalidPatch _) -> True
_ -> False
-- PSR-10: round-trip
it "PSR-10: parsePatch . formatPatch is identity" $
let p = Patch (Just (FileHeader "a" "b"))
[ Hunk 1 2 1 2
[ Line Context "ctx"
, Line Removed "old"
, Line Added "new"
]
]
in parsePatch (formatPatch p) `shouldBe` Right p
-- PSR-11: context line containing @@ is parsed correctly (regression)
-- A context line starting with ' ' followed by @@ must NOT be treated as a
-- hunk header; pRestOfLine consumes the entire line including any @@ within.
it "PSR-11: context line containing @@ is parsed correctly" $
parsePatch "@@ -1,3 +1,3 @@\n ctx before\n @@ not a hunk header\n ctx after\n"
`shouldBe`
Right (Patch Nothing
[ Hunk 1 3 1 3
[ Line Context "ctx before"
, Line Context "@@ not a hunk header"
, Line Context "ctx after"
]
])
-- PSR-12: removed line containing @@ is parsed correctly (regression)
-- A '-' line containing @@ must be read as a Removed line, not a hunk header.
it "PSR-12: removed line containing @@ is parsed correctly" $
parsePatch "@@ -1,2 +1,1 @@\n-old @@ -2,3 +2,3 $@ style text\n ctx after\n"
`shouldBe`
Right (Patch Nothing
[ Hunk 1 2 1 1
[ Line Removed "old @@ -2,3 +2,3 $@ style text"
, Line Context "ctx after"
]
])
-- PSR-13: added line containing @@ is parsed correctly (regression)
-- A '+' line containing @@ must be read as an Added line, not a hunk header.
it "PSR-13: added line containing @@ is parsed correctly" $
parsePatch "@@ -1,1 +1,2 @@\n ctx before\n+new @@ -5,1 +5,1 $@ style text\n"
`shouldBe`
Right (Patch Nothing
[ Hunk 1 1 1 2
[ Line Context "ctx before"
, Line Added "new @@ -5,1 +5,1 $@ style text"
]
])
-- PSR-14: bare newline (no leading space) as empty context line is tolerated.
-- This is the primary fix target for CR-04.
-- LLM-generated patches often omit the leading space on blank context lines,
-- emitting a bare "\n" instead of the spec-compliant " \n".
-- The parser must accept this and treat it as Line Context "".
-- NOTE: this test FAILS with the current implementation and will pass
-- only after the fix (char '\n' branch added to pDiffLine) is applied.
it "PSR-14: bare newline as empty context line is tolerated (LLM patch tolerance)" $
parsePatch "@@ -1,3 +1,3 @@\n ctx1\n-old line\n+new line\n\n ctx3\n"
`shouldBe`
Right (Patch Nothing
[ Hunk 1 3 1 3
[ Line Context "ctx1"
, Line Removed "old line"
, Line Added "new line"
, Line Context ""
, Line Context "ctx3"
]
])
-- ---------------------------------------------------------------------------
-- Integration tests: full ProjectedContext pipeline
-- ---------------------------------------------------------------------------
describe "runPipeline (integration)" $ do
-- INT-01: 1-line replacement
it "INT-01: 1-line replacement" $
runPipeline "a\n" "b\n" `shouldBe` Right "b\n"
-- INT-02: 5-line file, middle line changed
it "INT-02: middle line replaced in a 5-line file" $
runPipeline "a\nb\nc\nd\ne\n" "a\nb\nX\nd\ne\n"
`shouldBe` Right "a\nb\nX\nd\ne\n"
-- INT-03: line appended at end
it "INT-03: line appended at end" $
runPipeline "a\nb\nc\n" "a\nb\nc\nd\n"
`shouldBe` Right "a\nb\nc\nd\n"
-- INT-04: line deleted in the middle
it "INT-04: line deleted in the middle" $
runPipeline "a\nb\nc\n" "a\nc\n"
`shouldBe` Right "a\nc\n"
-- INT-05: CRLF input is normalised to LF; output is always LF
it "INT-05: CRLF input normalised to LF before and after pipeline" $
runPipeline "a\r\nb\r\n" "a\r\nc\r\n"
`shouldBe` Right "a\nc\n"
-- INT-06: empty -> non-empty
it "INT-06: empty old text to non-empty new text" $
runPipeline "" "hello\n" `shouldBe` Right "hello\n"
-- INT-07: non-empty -> empty
it "INT-07: non-empty old text to empty new text" $
runPipeline "hello\n" "" `shouldBe` Right ""
-- INT-08: two distant changes produce two hunks and are both applied
it "INT-08: two distant changes (two hunks) are both applied correctly" $
let old8 = "a\nb\nc\n1\n2\n3\n4\n5\nd\ne\nf\n"
new8 = "a\nX\nc\n1\n2\n3\n4\n5\nd\nY\nf\n"
in runPipeline old8 new8 `shouldBe` Right new8
-- INT-09: UTF-8 multi-byte characters
it "INT-09: multi-byte (Japanese) text handled correctly" $
runPipeline "\12354\n\12356\n\12358\n" "\12354\nX\n\12358\n"
`shouldBe` Right "\12354\nX\n\12358\n"
-- ---------------------------------------------------------------------------
-- generateSearchIndices unit tests
-- ---------------------------------------------------------------------------
describe "generateSearchIndices" $ do
-- GSI-01: normal case, no boundary clipping
it "GSI-01: center=5, fuzz=2, maxLen=10 produces [5,6,4,7,3]" $
generateSearchIndices 5 2 10 `shouldBe` [5, 6, 4, 7, 3]
-- GSI-02: negative candidates clipped at lower boundary
it "GSI-02: center=0, fuzz=2, maxLen=10 clips negatives -> [0,1,2]" $
generateSearchIndices 0 2 10 `shouldBe` [0, 1, 2]
-- GSI-03: candidates above maxLen clipped at upper boundary
it "GSI-03: center=10, fuzz=2, maxLen=10 clips > maxLen -> [10,9,8]" $
generateSearchIndices 10 2 10 `shouldBe` [10, 9, 8]
-- ---------------------------------------------------------------------------
-- applyHunkFuzzy unit tests
-- ---------------------------------------------------------------------------
describe "applyHunkFuzzy" $ do
let mkSrc = ["ctx1","ctx2","old","ctx4","ctx5","ctx6","ctx7","ctx8","ctx9","ctx10","ctx11","ctx12"]
mkHunk start =
Hunk { _oldStartHunk = start, _oldCountHunk = 3
, _newStartHunk = start, _newCountHunk = 3
, _linesHunk =
[ Line Context "ctx2"
, Line Removed "old", Line Added "new"
, Line Context "ctx4"
]
}
expected = ["ctx1","ctx2","new","ctx4","ctx5","ctx6","ctx7","ctx8","ctx9","ctx10","ctx11","ctx12"]
it "AHF-01: hint is exact, applies normally" $
applyHunkFuzzy 1 mkSrc (mkHunk 2)
`shouldBe` Right expected
it "AHF-02: hint drifted +1, fuzzy absorbs it" $
applyHunkFuzzy 1 mkSrc (mkHunk 3)
`shouldBe` Right expected
it "AHF-03: hint drifted -1, fuzzy absorbs it" $
applyHunkFuzzy 1 mkSrc (mkHunk 1)
`shouldBe` Right expected
it "AHF-04: hint drifted +_FUZZY_RANGE (boundary), fuzzy absorbs it" $
applyHunkFuzzy 1 mkSrc (mkHunk (2 + _FUZZY_RANGE))
`shouldBe` Right expected
it "AHF-05: hint drift exceeds _FUZZY_RANGE, returns InvalidPatch" $
applyHunkFuzzy 1 mkSrc (mkHunk (2 + _FUZZY_RANGE + 1))
`shouldSatisfy` \r -> case r of
Left (InvalidPatch _) -> True
_ -> False
-- AHF-06: Misapplication Prevention Test
-- Ensure the patch is applied only at the correct position in a source where multiple similar contexts exist.
it "AHF-06: similar contexts exist, patch applies only at correct position" $
let -- Source: The same pattern exists in two places (lines 1-3 and lines 8-10)
dupSrc = [ "alpha", "beta", "gamma" -- lines 1-3 (target group A)
, "delta", "epsilon", "zeta" -- lines 4-6
, "eta" -- line 7
, "alpha", "beta", "gamma" -- lines 8-10 (target group B, same as A)
, "theta" -- line 11
]
-- hunk: Changes "beta" on line 2 to "BETA". oldStart=2 is the correct position.
hunkA = Hunk { _oldStartHunk = 2, _oldCountHunk = 1
, _newStartHunk = 2, _newCountHunk = 1
, _linesHunk = [ Line Removed "beta", Line Added "BETA" ]
}
-- Correct application: Only the "beta" in line 2 (group A) should be changed.
expectedA = [ "alpha", "BETA", "gamma"
, "delta", "epsilon", "zeta"
, "eta"
, "alpha", "beta", "gamma"
, "theta"
]
in applyHunkFuzzy 1 dupSrc hunkA `shouldBe` Right expectedA
-- AHF-07: Fuzzy Search Range Expansion Effectiveness Test (_FUZZY_RANGE=5)
-- Ensure that cases with a drift of 4 or 5 lines are properly handled/absorbed.
it "AHF-07: drift of 4 lines absorbed by _FUZZY_RANGE=5" $
let longSrc = [ "pad1", "pad2", "pad3", "pad4" -- lines 1-4 (padding)
, "ctx2", "old", "ctx4" -- lines 5-7 (actual target)
, "pad5", "pad6", "pad7", "pad8", "pad9"
]
-- hunk declares oldStart=1 (4 lines drift from actual position 5)
driftHunk = Hunk { _oldStartHunk = 1, _oldCountHunk = 3
, _newStartHunk = 1, _newCountHunk = 3
, _linesHunk =
[ Line Context "ctx2"
, Line Removed "old", Line Added "new"
, Line Context "ctx4"
]
}
expectedDrift = [ "pad1", "pad2", "pad3", "pad4"
, "ctx2", "new", "ctx4"
, "pad5", "pad6", "pad7", "pad8", "pad9"
]
in applyHunkFuzzy 1 longSrc driftHunk `shouldBe` Right expectedDrift
-- ---------------------------------------------------------------------------
-- Fuzzy Patching multi-hunk integration tests (applyPatchText)
-- ---------------------------------------------------------------------------
describe "Fuzzy Patching multi-hunk integration" $ do
let baseLines =
[ "line1", "line2", "line3", "line4", "line5"
, "line6", "line7", "line8", "line9", "line10"
]
baseText = T.intercalate "\n" baseLines <> "\n"
mkPatchText hunk2Start =
"@@ -2,1 +2,2 @@\n"
<> "-line2\n"
<> "+line2a\n"
<> "+line2b\n"
<> "@@ -" <> T.pack (show hunk2Start) <> ",1 +" <> T.pack (show hunk2Start) <> ",1 @@\n"
<> "-line8\n"
<> "+LINE8\n"
expected = T.intercalate "\n"
["line1","line2a","line2b","line3","line4","line5"
,"line6","line7","LINE8","line9","line10"] <> "\n"
-- FUZZY-01: hunk2 oldStart correct (8), exact hit
it "FUZZY-01: delta=+1, hunk2 oldStart correct, applies cleanly" $
let patch = mkPatchText (8 :: Int)
in case parsePatch patch of
Left e -> expectationFailure (show e)
Right _ -> either expectationFailure (`shouldBe` expected)
(applyPatchText baseText patch)
-- FUZZY-02: hunk2 oldStart drifted +1 (9 instead of 8)
it "FUZZY-02: delta=+1, hunk2 oldStart +1 drift absorbed by fuzzy" $
let patch = mkPatchText (9 :: Int)
in case parsePatch patch of
Left e -> expectationFailure (show e)
Right _ -> either expectationFailure (`shouldBe` expected)
(applyPatchText baseText patch)
-- FUZZY-03: hunk2 oldStart drifted -1 (7 instead of 8)
it "FUZZY-03: delta=+1, hunk2 oldStart -1 drift absorbed by fuzzy" $
let patch = mkPatchText (7 :: Int)
in case parsePatch patch of
Left e -> expectationFailure (show e)
Right _ -> either expectationFailure (`shouldBe` expected)
(applyPatchText baseText patch)
-- FUZZY-04: drift exceeds _FUZZY_RANGE, returns Left error
it "FUZZY-04: drift exceeds _FUZZY_RANGE, returns Left error" $
let patch = mkPatchText (8 + _FUZZY_RANGE + 2)
in case parsePatch patch of
Left e -> expectationFailure (show e)
Right _ -> applyPatchText baseText patch
`shouldSatisfy` \r -> case r of
Left _ -> True
_ -> False
-- ---------------------------------------------------------------------------
-- QuickCheck property test
-- ---------------------------------------------------------------------------
describe "myers (QuickCheck)" $ do
it "QC-01: myers input line preservation property" $
property $ \(oldStrs :: [String]) (newStrs :: [String]) ->
let old' = map T.pack oldStrs
new' = map T.pack newStrs
edits = myers old' new'
nDel = length [() | Delete _ <- edits]
nIns = length [() | Insert _ <- edits]
nKeep = length [() | Keep _ <- edits]
in nDel + nKeep == length old' && nIns + nKeep == length new'