diff --git a/CHANGELOG.md b/CHANGELOG.md new file mode 100644 --- /dev/null +++ b/CHANGELOG.md @@ -0,0 +1,5 @@ +# Revision history for ai-agent-diff-patch + +## 0.0.1.0 -- 2026-05-15 + +* First version. Released on an unsuspecting world. diff --git a/LICENSE b/LICENSE new file mode 100644 --- /dev/null +++ b/LICENSE @@ -0,0 +1,20 @@ +Copyright (c) 2026 phoityne.hs@gmail.com + +Permission is hereby granted, free of charge, to any person obtaining +a copy of this software and associated documentation files (the +"Software"), to deal in the Software without restriction, including +without limitation the rights to use, copy, modify, merge, publish, +distribute, sublicense, and/or sell copies of the Software, and to +permit persons to whom the Software is furnished to do so, subject to +the following conditions: + +The above copyright notice and this permission notice shall be included +in all copies or substantial portions of the Software. + +THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, +EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF +MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. +IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY +CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, +TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE +SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. diff --git a/README.md b/README.md new file mode 100644 --- /dev/null +++ b/README.md @@ -0,0 +1,228 @@ +# ai-agent-diff-patch + +A Haskell library for unified diff generation and fuzzy patch application, +designed for AI agents and automated file-editing tools. + +--- + +## Overview + +`ai-agent-diff-patch` provides three simple entry points for working with +[unified diff](https://www.gnu.org/software/diffutils/manual/html_node/Unified-Format.html) +format patches: + +- **diff** — compare two text files and emit a unified diff to stdout +- **patch** — apply a unified diff patch to a file and emit the result to stdout +- **patchFile** — apply a unified diff patch to a file and write the result back in place + +The library is used as the backend for the +[pty-mcp-server](https://github.com/phoityne/pty-mcp-server) `pms-patch-file` MCP tool, +which lets AI agents edit files by generating and applying minimal patches instead of +rewriting entire file contents. + +--- + +## Features + +- Unified diff generation using the Myers O(ND) algorithm +- Fuzzy patch application with configurable line-number drift tolerance +- Automatic CRLF / LF line-ending detection and round-trip restoration (Windows compatible) +- Rich failure diagnostics: failed hunk index, header, search range, and nearest mismatch +- No dependency on external diff/patch executables + +--- + +## Installation + +Add the library to your `build-depends` in your `.cabal` file: + +```cabal +build-depends: + ai-agent-diff-patch +``` + +Or, to build from source, clone the repository and run: + +``` +cabal build +``` + +--- + +## Usage + +```haskell +import AIAgent.DiffPatch.Unified + +-- | Compare two files and write the unified diff to stdout. +diff :: FilePath -> FilePath -> IO (Either String ()) + +-- | Apply a unified diff patch to a file and write the result to stdout. +patch :: FilePath -> String -> IO (Either String ()) + +-- | Apply a unified diff patch to a file and write the result back to the same file. +patchFile :: FilePath -> String -> IO (Either String ()) +``` + +### diff + +```haskell +result <- diff "old.txt" "new.txt" +case result of + Left err -> putStrLn $ "diff failed: " ++ err + Right () -> pure () -- unified diff has been written to stdout +``` + +### patch + +```haskell +let patchText = unlines + [ "--- old.txt" + , "+++ new.txt" + , "@@ -1,3 +1,3 @@" + , " line1" + , "-line2" + , "+line2 modified" + , " line3" + ] +result <- patch "old.txt" patchText +case result of + Left err -> putStrLn $ "patch failed: " ++ err + Right () -> pure () -- patched content has been written to stdout +``` + +### patchFile + +```haskell +result <- patchFile "target.txt" patchText +case result of + Left err -> putStrLn $ "patchFile failed: " ++ err + Right () -> pure () -- target.txt has been updated in place +``` + +All three functions return `Left errorMessage` on failure; no exceptions are thrown. + +--- + +## Algorithms + +### Myers Diff Algorithm + +Diff generation is implemented using the **Myers O(ND) algorithm**: + +> E. W. Myers, *"An O(ND) Difference Algorithm and Its Variations"*, +> Algorithmica, 1986. + +The algorithm finds the shortest edit script between two sequences of lines, +producing compact unified diff output. +Time complexity is O(ND), where N is the total number of lines and D is the +size of the minimum edit (number of insertions + deletions). +The implementation uses an unboxed vector frontier for the forward phase and +a snapshot trace for the backward phase, following Myers' original formulation. + +Context lines surrounding each changed block default to **3 lines**, matching +the GNU `diff -u` convention. + +### Fuzzy Patching + +Patch application uses **fuzzy matching** to tolerate line-number drift that +commonly occurs when an AI agent generates a patch against a slightly outdated +view of a file. + +When applying a hunk, the algorithm: + +1. Reads the `oldStart` hint from the hunk header. +2. Generates candidate positions by expanding outward from the hint: + `hint, hint+1, hint-1, hint+2, hint-2, ...` up to `+-_FUZZY_RANGE` (default: **5**). +3. Tests each candidate by verifying that the hunk's `Context` and `Removed` + lines match the file content at that position. +4. Applies the hunk at the first matching position. + +If no candidate matches, a detailed error message is produced (see *Limitations*). + +--- + +## Limitations + +### Fuzzy Patching search range + +The fuzzy search window is `+-5` lines from the hunk's stated `oldStart`. +Line-number drift larger than 5 lines will cause the patch to fail with an +`InvalidPatch` error. + +When multiple regions of the file contain similar context lines, the fuzzy +search may match an unintended location. To reduce this risk, keep hunk +context lines as specific as possible and avoid overly generic surrounding lines. + +If the number of `Context + Removed` lines in the hunk body does not match +`oldCount` in the hunk header, the patch fails immediately and the diagnostic +message includes a `[MISMATCH]` marker showing the discrepancy. + +### Diff algorithm performance + +The Myers algorithm runs in O(ND) time, where D is the edit distance. +For files with a large number of differences (high D), performance degrades +toward O(N^2). The internal LCS fallback table requires O(m x n) space, making +it unsuitable for very large files (tens of thousands of lines or more). + +### Non-UTF-8 bytes are silently replaced + +Files are read in binary mode and decoded as UTF-8 using **lenient decoding**. +Any byte sequence that is not valid UTF-8 is silently replaced with the Unicode +replacement character U+FFFD rather than causing an error. +This means corrupted or non-UTF-8 encoded files (e.g. Latin-1, Shift-JIS) will +be read without error, but their content will be silently altered. +The replacement characters will also propagate into any generated diff or +patched output, potentially corrupting the result. +Always ensure input files are valid UTF-8 before using this library. + +### Binary files not supported + +The library operates on `Text` values decoded from UTF-8. +Binary files will be partially decoded and corrupted as described above; +their use is not supported. + +### Single-file patches only + +Each call to `patch` / `patchFile` processes a single file. Multi-file patch +bundles (as produced by `git diff` across multiple files) are not supported. +Strip the relevant hunk(s) for the target file before calling the library. + +### No newline at end of file marker not supported + +The unified diff `\ No newline at end of file` marker is neither parsed nor +emitted. Files that lack a trailing newline are handled silently; the marker +will not appear in generated diffs. + +### VCS-specific extended headers not supported + +Extended headers produced by VCS tools -- such as `diff --git a/... b/...` or +`index ..` lines -- are not parsed. Only the standard +`--- old` / `+++ new` file header and `@@ ... @@` hunk headers are recognised. + +--- + +## Architecture + +`ai-agent-diff-patch` is structured according to the +**Core Projection Architecture ([CPA](https://github.com/lambda-tuber/core-projection-architecture/blob/main/README_en.md))**: + + +| CPA Layer | Module | Responsibility | +|---|---|---| +| CoreModel | `CoreModel.Type` / `CoreModel.Constant` | Domain types (`Hunk`, `Patch`, `PatchError`, ...) and constants; no IO | +| ProjectedContext | `ProjectedContext.Algorithm` / `Parser` / `Context` | Myers diff, fuzzy patching, unified diff parser; pure functions + AppContext actions | +| ApplicationBase | `ApplicationBase.Control` | Use-case runners (`runDiff`, `runPatch`, `runPatchFile`); assembles the monad stack | +| Interface / Boot | `Interface.FileIO` / `Interface.StdIO` / `Unified` | Concrete IO implementations; public API entry point | + +IO is confined to the Interface and Boot layers. +The CoreModel and ProjectedContext layers contain only pure functions, +making them straightforward to test in isolation. + +--- + +## Credits & License + +- **Execution & Process Lead:** Sonnet 4.6, Gemini 3 Flash, GPT-5.5 +- **Direction & Policy:** phoityne +- **License:** MIT -- see [LICENSE](./LICENSE) diff --git a/ai-agent-diff-patch.cabal b/ai-agent-diff-patch.cabal new file mode 100644 --- /dev/null +++ b/ai-agent-diff-patch.cabal @@ -0,0 +1,117 @@ +cabal-version: 3.0 +name: ai-agent-diff-patch +version: 0.0.1.0 +synopsis: Unified diff generation and fuzzy patch application for AI agents +description: + A Haskell library for unified diff generation and patch application, + designed for use with AI agents and automated file-editing tools. + . + Key features: + . + * Myers O(ND) diff algorithm for minimal edit scripts + * Fuzzy patch application with configurable search range (default: ±5 lines) + * CRLF / LF line-ending detection and restoration (Windows compatible) + * Rich failure diagnostics for patch errors (hunk index, header, nearest mismatch) + . + See the README for usage examples and known limitations. +homepage: https://github.com/phoityne/ai-agent-diff-patch +bug-reports: https://github.com/phoityne/ai-agent-diff-patch/issues +license: MIT +license-file: LICENSE +author: phoityne.hs@gmail.com +maintainer: phoityne.hs@gmail.com +category: Text +build-type: Simple +extra-doc-files: + CHANGELOG.md + , README.md + +common warnings + ghc-options: -Wall + +library + import: warnings + + -- Public API: only AIAgent.DiffPatch.Unified is exposed + exposed-modules: + AIAgent.DiffPatch.Unified + , AIAgent.DiffPatch.Unified.ProjectedContext.Context + , AIAgent.DiffPatch.Unified.ProjectedContext.Algorithm + , AIAgent.DiffPatch.Unified.ProjectedContext.Parser + , AIAgent.DiffPatch.Unified.CoreModel.Type + , AIAgent.DiffPatch.Unified.CoreModel.Constant + , AIAgent.DiffPatch.Unified.ApplicationBase.Control + , AIAgent.DiffPatch.Unified.Interface.FileIO + , AIAgent.DiffPatch.Unified.Interface.StdIO + + build-depends: + base ^>=4.18.0.0 + , text + , bytestring + , megaparsec + , vector + , array + , lens + , mtl + , data-default + , transformers + , safe-exceptions + + hs-source-dirs: src + default-language: Haskell2010 + +executable aa-diff + import: warnings + default-language: Haskell2010 + main-is: AiAgentDiff.hs + hs-source-dirs: app + other-modules: Paths_ai_agent_diff_patch + autogen-modules: Paths_ai_agent_diff_patch + build-depends: + base ^>=4.18.0.0 + , text + , bytestring + , optparse-applicative + , safe-exceptions + , ai-agent-diff-patch + +executable aa-patch + import: warnings + default-language: Haskell2010 + main-is: AiAgentPatch.hs + hs-source-dirs: app + other-modules: Paths_ai_agent_diff_patch + autogen-modules: Paths_ai_agent_diff_patch + build-depends: + base ^>=4.18.0.0 + , text + , bytestring + , optparse-applicative + , safe-exceptions + , ai-agent-diff-patch + +test-suite ai-agent-diff-patch-test + import: warnings + default-language: Haskell2010 + type: exitcode-stdio-1.0 + hs-source-dirs: test + main-is: Spec.hs + + other-modules: + AIAgent.DiffPatch.Unified.ApplicationBase.ControlSpec + , AIAgent.DiffPatch.Unified.ProjectedContext.ContextSpec + , AIAgent.DiffPatch.Unified.UnifiedSpec + + build-depends: + base ^>=4.18.0.0 + , text + , bytestring + , hspec + , hspec-discover + , QuickCheck + , data-default + , temporary + , ai-agent-diff-patch + + build-tool-depends: + hspec-discover:hspec-discover diff --git a/app/AiAgentDiff.hs b/app/AiAgentDiff.hs new file mode 100644 --- /dev/null +++ b/app/AiAgentDiff.hs @@ -0,0 +1,59 @@ +{-# LANGUAGE OverloadedStrings #-} + +-- | Boot layer: entry point for the ai-agent-diff executable. +-- Handles command-line argument parsing and error reporting only. +-- All file I/O and diff computation are delegated to U.diff (AIAgent.DiffPatch.Unified). +module Main where + +import System.IO +import System.Exit +import Options.Applicative +import qualified Data.ByteString as BS +import qualified Data.Text as T +import qualified Data.Text.Encoding as TE +import qualified AIAgent.DiffPatch.Unified as U +import Paths_ai_agent_diff_patch (version) +import Data.Version (showVersion) + +-- | Command-line arguments for ai-agent-diff. +data ArgData = ArgData + { _oldFileArgData :: FilePath + , _newFileArgData :: FilePath + } deriving (Show) + +-- | Entry point. +main :: IO () +main = do + hSetBinaryMode stdout True + hSetBinaryMode stderr True + args <- execParser parseInfo + result <- U.diff (_oldFileArgData args) (_newFileArgData args) + case result of + Right () -> return () + Left err -> do + BS.hPutStr stderr (TE.encodeUtf8 (T.pack ("Error: " ++ err ++ "\n"))) + exitFailure + +-- | Version option: display version string and exit. +verOpt :: Parser (a -> a) +verOpt = infoOption msg $ mconcat + [ short 'v' + , long "version" + , help "Show version" + ] + where + msg = "ai-agent-diff-" ++ showVersion version + +-- | Parser info with help text. +parseInfo :: ParserInfo ArgData +parseInfo = info (helper <*> verOpt <*> options) $ mconcat + [ fullDesc + , header "ai-agent-diff - Generate unified diff between two files" + , progDesc "Read OLD-FILE and NEW-FILE, output unified diff to stdout." + ] + +-- | Positional argument parser. +options :: Parser ArgData +options = ArgData + <$> strArgument (metavar "OLD-FILE" <> help "Original file") + <*> strArgument (metavar "NEW-FILE" <> help "Modified file") diff --git a/app/AiAgentPatch.hs b/app/AiAgentPatch.hs new file mode 100644 --- /dev/null +++ b/app/AiAgentPatch.hs @@ -0,0 +1,66 @@ +{-# LANGUAGE OverloadedStrings #-} + +-- | Boot layer: entry point for the ai-agent-patch executable. +-- Handles command-line argument parsing and error reporting only. +-- All file I/O, line-ending handling, and patch computation are delegated +-- to U.patch (AIAgent.DiffPatch.Unified). +module Main where + +import System.IO +import System.Exit +import Options.Applicative +import qualified Data.ByteString as BS +import qualified Data.Text as T +import qualified Data.Text.Encoding as TE +import Data.Text.Encoding.Error (lenientDecode) +import qualified AIAgent.DiffPatch.Unified as U +import Paths_ai_agent_diff_patch (version) +import Data.Version (showVersion) + +-- | Command-line arguments for ai-agent-patch. +data ArgData = ArgData + { _origFileArgData :: FilePath + , _patchFileArgData :: FilePath + } deriving (Show) + +-- | Read a file as UTF-8 String, independent of the system locale. +readFileUtf8 :: FilePath -> IO String +readFileUtf8 path = T.unpack . TE.decodeUtf8With lenientDecode <$> BS.readFile path + +-- | Entry point. +main :: IO () +main = do + hSetBinaryMode stdout True + hSetBinaryMode stderr True + args <- execParser parseInfo + patchText <- readFileUtf8 (_patchFileArgData args) + result <- U.patch (_origFileArgData args) patchText + case result of + Right () -> return () + Left err -> do + BS.hPutStr stderr (TE.encodeUtf8 (T.pack ("Patch failed: " ++ err ++ "\n"))) + exitFailure + +-- | Version option: display version string and exit. +verOpt :: Parser (a -> a) +verOpt = infoOption msg $ mconcat + [ short 'v' + , long "version" + , help "Show version" + ] + where + msg = "ai-agent-patch-" ++ showVersion version + +-- | Parser info with help text. +parseInfo :: ParserInfo ArgData +parseInfo = info (helper <*> verOpt <*> options) $ mconcat + [ fullDesc + , header "ai-agent-patch - Apply a unified diff patch to a file" + , progDesc "Read ORIGINAL-FILE and PATCH-FILE, output patched text to stdout." + ] + +-- | Positional argument parser. +options :: Parser ArgData +options = ArgData + <$> strArgument (metavar "ORIGINAL-FILE" <> help "File to patch") + <*> strArgument (metavar "PATCH-FILE" <> help "Unified diff patch file") diff --git a/src/AIAgent/DiffPatch/Unified.hs b/src/AIAgent/DiffPatch/Unified.hs new file mode 100644 --- /dev/null +++ b/src/AIAgent/DiffPatch/Unified.hs @@ -0,0 +1,106 @@ +{-# LANGUAGE OverloadedStrings #-} + +-- | Boot layer: public API for the ai-agent-diff-patch library. +-- +-- Provides three file-based operations built on the CPA AppContext structure: +-- +-- * 'diff' — compare two files and write unified diff to stdout +-- * 'patch' — apply a patch to a file and write the result to stdout +-- * 'patchFile' — apply a patch to a file and write the result back in place +-- +-- IOFunc values are assembled here explicitly rather than via 'Data.Default', +-- so the I\/O wiring is visible at the single point of entry. +-- +-- === Example +-- +-- @ +-- import AIAgent.DiffPatch.Unified +-- +-- main :: IO () +-- main = do +-- -- generate a diff and print to stdout +-- diff "old.txt" "new.txt" >>= either putStrLn pure +-- +-- -- apply a patch file in place +-- patchText <- readFile "changes.patch" +-- patchFile "target.txt" patchText >>= either putStrLn pure +-- @ +-- +-- === Limitations +-- +-- * Fuzzy search window is ±5 lines; larger line-number drift will fail. +-- * Myers diff degrades toward O(N²) for files with many differences. +-- * Binary files, multi-file patches, and VCS-specific headers are not supported. +-- * The @\\ No newline at end of file@ marker is not parsed or emitted. +-- +-- See the README for the full list of known limitations. +module AIAgent.DiffPatch.Unified + ( diff + , patch + , patchFile + ) where + +import AIAgent.DiffPatch.Unified.CoreModel.Type (IOFunc (..)) +import qualified AIAgent.DiffPatch.Unified.Interface.FileIO as F +import qualified AIAgent.DiffPatch.Unified.Interface.StdIO as S +import qualified AIAgent.DiffPatch.Unified.ApplicationBase.Control as Control + +-- | Compute the unified diff between two files and write the result to stdout. +-- +-- Uses the Myers O(ND) algorithm with 3 context lines (GNU @diff -u@ default). +-- Returns @Left errorMessage@ if either file cannot be read. +-- +-- === Example +-- +-- @ +-- result <- diff "old.txt" "new.txt" +-- case result of +-- Left err -> putStrLn $ "diff failed: " ++ err +-- Right () -> pure () -- unified diff has been written to stdout +-- @ +diff :: FilePath -> FilePath -> IO (Either String ()) +diff oldFile newFile = + let ioFunc = IOFunc { _readIOFunc = F.read, _writeIOFunc = S.write } + in Control.runDiff ioFunc oldFile newFile + +-- | Apply a unified diff patch to a file and write the patched result to stdout. +-- +-- Fuzzy matching tolerates line-number drift of up to ±5 lines. +-- Returns @Left errorMessage@ on parse failure, hunk mismatch, or file read error. +-- No exceptions are thrown. +-- +-- === Example +-- +-- @ +-- let p = unlines ["@@ -1,2 +1,2 @@", " ctx", "-old", "+new"] +-- result <- patch "target.txt" p +-- case result of +-- Left err -> putStrLn $ "patch failed: " ++ err +-- Right () -> pure () +-- @ +patch :: FilePath -> String -> IO (Either String ()) +patch origFile patchText = + let ioFunc = IOFunc { _readIOFunc = F.read, _writeIOFunc = S.write } + in Control.runPatch ioFunc origFile patchText + +-- | Apply a unified diff patch to a file and write the result back to the same file. +-- +-- Identical to 'patch' except the patched content replaces the original file +-- rather than being written to stdout. +-- Line endings (LF or CRLF) are detected from the original file and restored +-- in the output. +-- Returns @Left errorMessage@ on any failure; the original file is not modified +-- if the patch cannot be applied. +-- +-- === Example +-- +-- @ +-- result <- patchFile "target.txt" patchText +-- case result of +-- Left err -> putStrLn $ "patchFile failed: " ++ err +-- Right () -> pure () -- target.txt has been updated in place +-- @ +patchFile :: FilePath -> String -> IO (Either String ()) +patchFile origFile patchText = + let ioFunc = IOFunc { _readIOFunc = F.read, _writeIOFunc = F.write } + in Control.runPatchFile ioFunc origFile patchText diff --git a/src/AIAgent/DiffPatch/Unified/ApplicationBase/Control.hs b/src/AIAgent/DiffPatch/Unified/ApplicationBase/Control.hs new file mode 100644 --- /dev/null +++ b/src/AIAgent/DiffPatch/Unified/ApplicationBase/Control.hs @@ -0,0 +1,44 @@ +{-# LANGUAGE OverloadedStrings #-} + +-- | ApplicationBase layer: assembles ProjectedContext projections into +-- the public use-cases and provides the monad-transformer +-- stack (AppContext) with its execution engine (runProjectedContext). +module AIAgent.DiffPatch.Unified.ApplicationBase.Control where + +import Control.Monad.Reader (runReaderT) +import Control.Monad.Except (runExceptT) + +import AIAgent.DiffPatch.Unified.CoreModel.Type +import AIAgent.DiffPatch.Unified.ProjectedContext.Context + ( patchPC, diffPC + ) + +-- --------------------------------------------------------------------------- +-- AppContext execution engine +-- --------------------------------------------------------------------------- + +-- | Execute an AppContext action, lowering it into IO. +-- Returns Right on success or Left with an error message on failure. +runProjectedContext :: AppData -> AppContext a -> IO (Either String a) +runProjectedContext appDat ctx = + runExceptT $ runReaderT ctx appDat + +-- --------------------------------------------------------------------------- +-- Use-case runners (Boot layer calls these with an assembled IOFunc) +-- --------------------------------------------------------------------------- + +-- | Apply a patch to a file, writing the result via '_writeIOFunc'. +-- Pass 'StdIO.write' for stdout output, or 'FileIO.write for file write-back. +runPatch :: IOFunc -> FilePath -> String -> IO (Either String ()) +runPatch ioFunc origFile patchText = + runProjectedContext (AppData ioFunc) (patchPC origFile patchText) + +-- | Alias: runPatchFile and runPatch share the same implementation; +-- the caller differentiates them by supplying a different IOFunc. +runPatchFile :: IOFunc -> FilePath -> String -> IO (Either String ()) +runPatchFile = runPatch + +-- | Run the diff use-case, writing the result via '_writeIOFunc'. +runDiff :: IOFunc -> FilePath -> FilePath -> IO (Either String ()) +runDiff ioFunc oldFile newFile = + runProjectedContext (AppData ioFunc) (diffPC oldFile newFile) diff --git a/src/AIAgent/DiffPatch/Unified/CoreModel/Constant.hs b/src/AIAgent/DiffPatch/Unified/CoreModel/Constant.hs new file mode 100644 --- /dev/null +++ b/src/AIAgent/DiffPatch/Unified/CoreModel/Constant.hs @@ -0,0 +1,29 @@ +{-# LANGUAGE OverloadedStrings #-} + +-- | CoreModel layer: constants shared across all layers. +-- Centralises literal values to avoid magic strings in the implementation. +module AIAgent.DiffPatch.Unified.CoreModel.Constant where + +import Data.Text (Text) + +-- | Line feed character (LF, U+000A). The canonical line ending used internally. +_LF :: Text +_LF = "\n" + +-- | Carriage return character (CR, U+000D). +_CR :: Text +_CR = "\r" + +-- | Carriage return followed by line feed (CRLF). Windows-style line ending. +_CRLF :: Text +_CRLF = "\r\n" + + +-- | Scan range (in lines) for Fuzzy Patching. +-- applyHunkFuzzy searches up and down this many lines from the hint position. +-- The maximum number of candidates is 2 * _FUZZY_RANGE + 1. +-- Increased from 3 to 5 to absorb larger line-number drift (CR-05). +_FUZZY_RANGE :: Int +_FUZZY_RANGE = 5 + + diff --git a/src/AIAgent/DiffPatch/Unified/CoreModel/Type.hs b/src/AIAgent/DiffPatch/Unified/CoreModel/Type.hs new file mode 100644 --- /dev/null +++ b/src/AIAgent/DiffPatch/Unified/CoreModel/Type.hs @@ -0,0 +1,149 @@ +{-# LANGUAGE TemplateHaskell #-} + +-- | CoreModel layer: all domain types for unified diff/patch operations. +-- This module has no IO and no dependencies beyond base, text, lens, and data-default. +module AIAgent.DiffPatch.Unified.CoreModel.Type where + +import Data.Text (Text, empty) +import qualified Data.Text as T +import Control.Lens +import Data.Default + +-- AppContext imports +import Control.Monad.Reader +import Control.Monad.Except + +-- | Classification of a diff line. +data LineType + = Context -- ^ line present in both old and new (unchanged) + | Added -- ^ line present only in new + | Removed -- ^ line present only in old + deriving (Show, Eq) + +-- | A single line in a diff hunk, with its type and content. +data Line = Line + { _typeLine :: LineType + , _contentLine :: Text -- ^ line content without trailing newline + } deriving (Show, Eq) + +makeLenses ''Line + +-- | A hunk represents one contiguous block of changes in unified diff format. +-- Corresponds to a single "@@ -old_start,old_count +new_start,new_count @@" section. +data Hunk = Hunk + { _oldStartHunk :: Int -- ^ 1-based start line in the old file + , _oldCountHunk :: Int -- ^ number of lines from the old file + , _newStartHunk :: Int -- ^ 1-based start line in the new file + , _newCountHunk :: Int -- ^ number of lines in the new file + , _linesHunk :: [Line] -- ^ context, added, and removed lines + } deriving (Show, Eq) + +makeLenses ''Hunk + +-- | Optional file header from "--- ..." and "+++ ..." lines. +-- When _headerPatch is Nothing, the patch uses the bare "@@ ... @@" format. +data FileHeader = FileHeader + { _oldPathFileHeader :: Text -- ^ content of the "--- ..." line (after the prefix) + , _newPathFileHeader :: Text -- ^ content of the "+++ ..." line (after the prefix) + } deriving (Show, Eq) + +makeLenses ''FileHeader + +-- | A complete patch: an optional file header followed by one or more hunks. +data Patch = Patch + { _headerPatch :: Maybe FileHeader -- ^ Nothing means header-less format + , _hunksPatch :: [Hunk] + } deriving (Show, Eq) + +makeLenses ''Patch + +-- | Error that can occur when applying a patch. +data PatchError + = HunkMismatch Int Text -- ^ line number and the expected line content + | InvalidPatch Text -- ^ any other failure, including parse errors + deriving (Show, Eq) + +-- | Options controlling diff generation. +data DiffOptions = DiffOptions + { _contextLinesDiffOptions :: Int -- ^ number of unchanged context lines around each hunk (default: 3) + } deriving (Show, Eq) + +makeLenses ''DiffOptions + +-- | Default options for diff generation. +-- +-- '_contextLinesDiffOptions' is set to 3, following the GNU diff \'-u\' option default +-- and the POSIX unified format specification. Three context lines have been +-- the industry-standard default since the introduction of the unified format: +-- they provide enough surrounding context for patch to locate the correct +-- application site without inflating patch size unnecessarily. +-- GNU diff, git diff, and most Unix diff implementations all default to 3. +instance Default DiffOptions where + def = DiffOptions { _contextLinesDiffOptions = 3 } + +-- | An element of the edit script produced by the Myers diff algorithm. +data Edit + = Keep Text -- ^ line present in both old and new (unchanged) + | Delete Text -- ^ line present only in old + | Insert Text -- ^ line present only in new + deriving (Show, Eq) + +-- | The original (before-change) file for diff/patch operations. +-- '_pathOriginalFile' is Nothing when the text is used purely in-memory. +data OriginalFile = OriginalFile + { _pathOriginalFile :: Maybe Text -- ^ absolute or relative path; Nothing for in-memory use + , _contentOriginalFile :: Text -- ^ full text content of the file + } deriving (Show, Eq) + +makeLenses ''OriginalFile + +instance Default OriginalFile where + def = OriginalFile + { _pathOriginalFile = Nothing + , _contentOriginalFile = empty + } + +-- | The modified (after-change) file produced by a diff or patch operation. +-- '_pathModifiedFile' is Nothing when the text is used purely in-memory. +data ModifiedFile = ModifiedFile + { _pathModifiedFile :: Maybe Text -- ^ same as OriginalFile path in patch operations + , _contentModifiedFile :: Text -- ^ full text content after modification + } deriving (Show, Eq) + +makeLenses ''ModifiedFile + +instance Default ModifiedFile where + def = ModifiedFile + { _pathModifiedFile = Nothing + , _contentModifiedFile = empty + } + +-- | A function record bundling file I/O operations for dependency injection. +-- Grouping read and write together forms a meaningful abstraction unit: +-- a single record represents "the ability to do file I/O", +-- which can be swapped out for testing or alternative output targets (e.g. stdout). +-- The Default instance is defined in Interface/FileIO.hs to avoid pulling +-- IO implementations into the CoreModel layer. +data IOFunc = IOFunc + { _readIOFunc :: FilePath -> IO T.Text + -- ^ Read a file and return its content as UTF-8 / LF-normalised Text. + , _writeIOFunc :: FilePath -> T.Text -> IO () + -- ^ Write Text to a file (restoring original line endings) or to stdout. + } + +makeLenses ''IOFunc + +-- | Application configuration data held in the monad-transformer stack. +-- Carries the injected IOFunc so that ProjectedContext functions can perform +-- file I/O without depending on a concrete implementation. +-- The Default instance is defined in Interface/FileIO.hs alongside IOFunc's Default. +data AppData = AppData + { _ioFuncAppData :: IOFunc + } + +makeLenses ''AppData + +-- | The application context stack. +-- ReaderT carries AppData (injected IOFunc) for configuration management. +-- ExceptT captures IO exceptions and domain errors as String. +type AppContext a = ReaderT AppData (ExceptT String IO) a diff --git a/src/AIAgent/DiffPatch/Unified/Interface/FileIO.hs b/src/AIAgent/DiffPatch/Unified/Interface/FileIO.hs new file mode 100644 --- /dev/null +++ b/src/AIAgent/DiffPatch/Unified/Interface/FileIO.hs @@ -0,0 +1,33 @@ +{-# LANGUAGE OverloadedStrings #-} + +-- | Interface layer: concrete file I/O implementation for IOFunc. +-- This module is responsible for raw I/O only: reading bytes from disk and +-- writing bytes to disk. All domain logic (line-ending detection, normalisation, +-- restoration) belongs to the ProjectedContext layer. +-- +-- IOFunc / AppData values are assembled directly in the Boot layer (Unified.hs) +-- without using Data.Default, keeping construction explicit and visible. +module AIAgent.DiffPatch.Unified.Interface.FileIO + ( read + , write + ) where + +import Prelude hiding (read) +import qualified Data.ByteString as BS +import qualified Data.Text as T +import qualified Data.Text.Encoding as TE +import Data.Text.Encoding.Error (lenientDecode) + +-- | Read a file in binary mode and decode as UTF-8 (lenient). +-- Returns raw Text with original line endings preserved. +-- Line-ending normalisation is a domain concern and is handled in ProjectedContext. +read :: FilePath -> IO T.Text +read path = do + bs <- BS.readFile path + return (TE.decodeUtf8With lenientDecode bs) + +-- | Write Text to a file as UTF-8 binary. +-- The caller is responsible for any line-ending conversion before calling this. +write :: FilePath -> T.Text -> IO () +write path txt = + BS.writeFile path (TE.encodeUtf8 txt) diff --git a/src/AIAgent/DiffPatch/Unified/Interface/StdIO.hs b/src/AIAgent/DiffPatch/Unified/Interface/StdIO.hs new file mode 100644 --- /dev/null +++ b/src/AIAgent/DiffPatch/Unified/Interface/StdIO.hs @@ -0,0 +1,22 @@ +{-# LANGUAGE OverloadedStrings #-} + +-- | Interface layer: stdout output implementation for IOFunc._writeIOFunc. +-- Used when the caller wants diff/patch results written to stdout +-- rather than back to a file (e.g. ai-agent-diff and ai-agent-patch executables). +module AIAgent.DiffPatch.Unified.Interface.StdIO + ( write + ) where + +import qualified Data.ByteString as BS +import qualified Data.Text as T +import qualified Data.Text.Encoding as TE +import System.IO (hSetBinaryMode, stdout) + +-- | Write Text to stdout as UTF-8 binary. +-- The FilePath argument is ignored; it exists only to match the +-- '_writeIOFunc :: FilePath -> T.Text -> IO ()' signature so that +-- write can be injected into IOFunc without a wrapper. +write :: FilePath -> T.Text -> IO () +write _ txt = do + hSetBinaryMode stdout True + BS.hPutStr stdout (TE.encodeUtf8 txt) diff --git a/src/AIAgent/DiffPatch/Unified/ProjectedContext/Algorithm.hs b/src/AIAgent/DiffPatch/Unified/ProjectedContext/Algorithm.hs new file mode 100644 --- /dev/null +++ b/src/AIAgent/DiffPatch/Unified/ProjectedContext/Algorithm.hs @@ -0,0 +1,473 @@ +{-# LANGUAGE OverloadedStrings #-} + +-- | ProjectedContext layer: diff/patch algorithm implementations. +-- Contains the Myers diff algorithm, LCS, hunk building, hunk application, +-- and fuzzy patching helpers. +-- All functions are pure; no IO is performed in this module. +module AIAgent.DiffPatch.Unified.ProjectedContext.Algorithm + ( lcs + , myers + , myersSearch + , buildEdits + , buildHunks + , applyHunk + , matchLines + , buildReplacement + , generateSearchIndices + , findFirstMatch + , findNearestMismatch + , applyHunkFuzzy + , Frontier + ) where + +import qualified Data.Text as T +import Data.Text (Text) +import Data.Array (listArray, array, (!)) +import AIAgent.DiffPatch.Unified.CoreModel.Type +import AIAgent.DiffPatch.Unified.CoreModel.Constant + +import qualified Data.Vector as V +import qualified Data.Vector.Unboxed as VU + + +-- | Compute an edit script from two lists of lines using the LCS algorithm. +-- Each element of the result indicates whether a line was kept, deleted, or inserted. +-- Uses dynamic programming to build an LCS table, then backtracks to produce the edit list. +lcs :: [Text] -> [Text] -> [Edit] +lcs old new = backtrack m n [] + where + m = length old + n = length new + oldV = listArray (1, max 1 m) old + newV = listArray (1, max 1 n) new + + -- DP table: tbl ! (i,j) = LCS length of old[1..i] and new[1..j] + tbl = array ((0, 0), (m, n)) + [ ((i, j), cell i j) | i <- [0..m], j <- [0..n] ] + + cell 0 _ = (0 :: Int) + cell _ 0 = 0 + cell i j + | oldV ! i == newV ! j = tbl ! (i-1, j-1) + 1 + | otherwise = max (tbl ! (i-1, j)) (tbl ! (i, j-1)) + + -- Backtrack using an accumulator to build the list in O(n) time. + -- To ensure the [Delete, Insert] order, we prioritize the Insert branch + -- when scores are tied, pushing Insert further towards the end of the final list. + backtrack i j acc + | i == 0 && j == 0 = acc + + -- Match: No change + | i > 0 && j > 0 && oldV ! i == newV ! j = + backtrack (i-1) (j-1) (Keep (oldV ! i) : acc) + + -- Prefer Insert branch when scores are tied to maintain + -- the conventional "Delete before Insert" ordering in the final result. + | j > 0 && (i == 0 || tbl ! (i, j-1) >= tbl ! (i-1, j)) = + backtrack i (j-1) (Insert (newV ! j) : acc) + + -- Delete branch + | i > 0 = + backtrack (i-1) j (Delete (oldV ! i) : acc) + + | otherwise = acc + + +-- --------------------------------------------------------------------------- +-- Myers diff +-- --------------------------------------------------------------------------- + +-- | Unboxed vector of Int used to represent the furthest-reaching x position +-- on each diagonal k. Element at logical diagonal k is stored at physical +-- index k + offset, where offset = m + n. +type Frontier = VU.Vector Int + +-- | Compute an edit script from two lists of lines using the Myers diff algorithm. +-- Implements the O(ND) algorithm from Myers (1986): +-- "An O(ND) Difference Algorithm and Its Variations" +-- +-- Key concepts: +-- x : position in old (0-based, lines consumed so far, 0..m) +-- y : position in new (0-based, lines consumed so far, 0..n) +-- k = x-y : diagonal index +-- v[k] : furthest x reached on diagonal k for a given edit count d +-- snake : free diagonal advances where old[x] == new[y] +-- snapshot : immutable copy of v after each d-round, used for backtracking +-- +-- CRITICAL INVARIANT: when computing the new frontier v' for edit count d, +-- all reads of v[k-1] and v[k+1] must come from the *previous* v (before any +-- updates for this d-round). This is enforced by computing all (k, x) pairs +-- first, then bulk-writing them into v'. +myers :: [Text] -> [Text] -> [Edit] +myers [] [] = [] +myers old [] = map Delete old +myers [] new = map Insert new +myers oldL newL = buildEdits m n old new (myersSearch m n old new) + where + -- Convert lists to vectors for O(1) indexed access. + old = V.fromList oldL + new = V.fromList newL + m = V.length old + n = V.length new + +-- | Forward phase of the Myers algorithm. +-- Iterates d = 0, 1, ..., m+n. For each d, computes the furthest x reachable +-- on every active diagonal k, reading exclusively from the previous round's +-- frontier (not the partially-updated one). Appends a snapshot of the updated +-- frontier after each round. Stops at the first d for which the endpoint +-- (x=m, y=n) is reached. +myersSearch :: Int -> Int -> V.Vector Text -> V.Vector Text -> [Frontier] +myersSearch m n old new = go 0 v0 [] + where + offset = m + n + size = 2 * offset + 1 + v0 = VU.replicate size 0 + + -- Advance diagonally from 0-based position (x, y) as long as lines match. + snake x y + | x < m && y < n && (old V.! x) == (new V.! y) = snake (x+1) (y+1) + | otherwise = x + + -- Compute the new x for diagonal k during edit round d, + -- reading exclusively from the previous frontier v. + -- Boundary rules: + -- k == -d : leftmost diagonal, must come from above (Insert) + -- k == d : rightmost diagonal, must come from below (Delete) + -- tie : prefer Insert (xIns >= xDel) to match the backtracking condition + newX v d k = + let xDel = (v VU.! (k - 1 + offset)) + 1 + xIns = (v VU.! (k + 1 + offset)) + x0 | k == -d = xIns + | k == d = xDel + | xIns >= xDel = xIns + | otherwise = xDel + in snake x0 (x0 - k) + + go d v acc = + let -- Compute all new x values from the current (old) frontier. + updates = [(k + offset, newX v d k) | k <- [-d, -d+2 .. d]] + -- Bulk-apply updates to produce the new frontier. + v' = v VU.// updates + acc' = v' : acc + xEnd = v' VU.! (m - n + offset) + yEnd = xEnd - (m - n) + in if xEnd >= m && yEnd >= n + then acc' + else go (d+1) v' acc' + +-- | Backward (trace) phase of the Myers algorithm. +-- Reconstructs the edit script by walking from (m, n) back to (0, 0) through +-- the frontier snapshots in reverse order. At each step, recovers the Delete +-- or Insert move that was taken, plus any preceding snake (Keep) moves. +-- Returns the edit script in correct forward order. +buildEdits :: Int -> Int -> V.Vector Text -> V.Vector Text -> [Frontier] -> [Edit] +buildEdits m n old new snaps = go m n snaps [] + where + offset = m + n + + -- Walk backward along a snake: while old[x-1]==new[y-1] it was a Keep move. + unsnake x y acc + | x > 0 && y > 0 && (old V.! (x-1)) == (new V.! (y-1)) = + unsnake (x-1) (y-1) (Keep (old V.! (x-1)) : acc) + | otherwise = (x, y, acc) + + -- Base: reached origin. + go 0 0 _ acc = acc + -- d=0 case: the entire path was a snake from the origin. + go x y [_] acc = + let (_, _, acc') = unsnake x y acc in acc' + -- General case: recover one edit step, then recurse with prevV. + go x y (_v:prevV:rest) acc = + let (xMid, yMid, accWithSnakes) = unsnake x y acc + k = xMid - yMid + d = length rest + 1 + + xFromDel = (prevV VU.! (k - 1 + offset)) + 1 + xFromIns = (prevV VU.! (k + 1 + offset)) + + -- Mirror the tie-breaking rule used in newX (forward phase). + cameFromInsert + | k == -d = True + | k == d = False + | otherwise = xFromIns >= xFromDel + + (xPrev, yPrev, edit) = + if cameFromInsert + then (xMid, yMid - 1, Insert (new V.! (yMid - 1))) + else (xMid - 1, yMid, Delete (old V.! (xMid - 1))) + in go xPrev yPrev (prevV:rest) (edit : accWithSnakes) + -- Unreachable: myersSearch guarantees snapshots cover all steps. + go _ _ [] acc = acc + + +-- --------------------------------------------------------------------------- +-- buildHunks +-- --------------------------------------------------------------------------- + +-- | Build a list of hunks from an edit script. +-- The Int argument specifies the number of unchanged context lines surrounding each hunk. +-- Adjacent change groups separated by 2*n or fewer Keep lines are merged into one hunk. +-- Returns an empty list when the edit script contains no Delete or Insert. +buildHunks :: Int -> [Edit] -> [Hunk] +buildHunks ctx edits + | null edits = [] + | otherwise = map makeHunk $ mergeGroups ctx $ groupEdits ctx numberedEdits + where + -- Annotate each Edit with 1-based old and new line numbers. + numberedEdits = numberEdits 1 1 edits + + -- Assign (oldLine, newLine) to each Edit. + -- Keep and Delete advance oldLine; Keep and Insert advance newLine. + numberEdits :: Int -> Int -> [Edit] -> [(Int, Int, Edit)] + numberEdits _ _ [] = [] + numberEdits ol nl (e@(Keep _):es) = (ol, nl, e) : numberEdits (ol+1) (nl+1) es + numberEdits ol nl (e@(Delete _):es) = (ol, nl, e) : numberEdits (ol+1) nl es + numberEdits ol nl (e@(Insert _):es) = (ol, nl, e) : numberEdits ol (nl+1) es + + -- A "group" is a window of numbered edits that will become one hunk. + -- It is represented as a flat list of (oldLine, newLine, Edit). + + -- Split the numbered edit list into raw change groups, each surrounded by + -- up to ctx context lines. + groupEdits :: Int -> [(Int, Int, Edit)] -> [[(Int, Int, Edit)]] + groupEdits n numbered = + let -- Locate all indices of Delete/Insert edits. + changeIdxs = [ i | (i, (_, _, e)) <- zip [0..] numbered, isChange e ] + in if null changeIdxs + then [] + else buildGroups n numbered changeIdxs + + isChange :: Edit -> Bool + isChange (Keep _) = False + isChange _ = True + + -- Collect groups, merging when inter-group Keep gap <= 2*ctx. + buildGroups :: Int -> [(Int, Int, Edit)] -> [Int] -> [[(Int, Int, Edit)]] + buildGroups n numbered idxs = go clusters + where + total = length numbered + + -- Cluster change indices into spans [firstChange..lastChange], + -- merging spans whose gap is <= 2*n. + clusterIdxs :: [Int] -> [(Int, Int)] + clusterIdxs [] = [] + clusterIdxs (i:is) = merge i i is + where + merge lo hi [] = [(lo, hi)] + merge lo hi (x:xs) + | x - hi <= 2 * n + 1 = merge lo x xs + | otherwise = (lo, hi) : merge x x xs + + clusters = clusterIdxs idxs + + -- Expand each cluster span to include ctx context lines on each side. + go [] = [] + go ((lo, hi):cs) = + let start = max 0 (lo - n) + end = min (total - 1) (hi + n) + in slice start end numbered : go cs + + -- Extract elements from index start to end (inclusive). + slice :: Int -> Int -> [a] -> [a] + slice s e xs = take (e - s + 1) (drop s xs) + + -- Build a Hunk from a group of numbered edits. + makeHunk :: [(Int, Int, Edit)] -> Hunk + makeHunk [] = Hunk 0 0 0 0 [] + makeHunk group = + let (oldStart, newStart, _) = head group + oldCount = length [ () | (_, _, e) <- group, isOldLine e ] + newCount = length [ () | (_, _, e) <- group, isNewLine e ] + hlines = map toLine group + in Hunk oldStart oldCount newStart newCount hlines + + isOldLine :: Edit -> Bool + isOldLine (Insert _) = False + isOldLine _ = True + + isNewLine :: Edit -> Bool + isNewLine (Delete _) = False + isNewLine _ = True + + toLine :: (Int, Int, Edit) -> Line + toLine (_, _, Keep t) = Line Context t + toLine (_, _, Delete t) = Line Removed t + toLine (_, _, Insert t) = Line Added t + + -- Merge adjacent groups when their Keep gap falls within 2*ctx. + -- groupEdits already handles merging via clusterIdxs; this is a no-op + -- pass-through kept for symmetry. + mergeGroups :: Int -> [[(Int, Int, Edit)]] -> [[(Int, Int, Edit)]] + mergeGroups _ = id + + +-- --------------------------------------------------------------------------- +-- applyHunk +-- --------------------------------------------------------------------------- + +-- | Apply a single hunk to a list of lines. +-- The source lines must match the Context and Removed lines declared in the hunk; +-- otherwise a PatchError is returned. +-- +-- Algorithm: +-- 1. Validate that _oldStartHunk is within range (1 .. length src + 1). +-- 2. Split src into before / target / after blocks using _oldStartHunk and _oldCountHunk. +-- 3. Walk _linesHunk, verifying each Context or Removed line against target. +-- Return HunkMismatch (with 1-based line number) on the first discrepancy. +-- 4. Build the replacement block from Context and Added lines in _linesHunk. +-- 5. Return Right (before ++ replacement ++ after). +applyHunk :: [Text] -> Hunk -> Either PatchError [Text] +applyHunk src hunk + -- _oldStartHunk must be in the range [1 .. length src + 1]. + -- (+1 allows a hunk that starts right after the last line, e.g. pure insertion at end.) + | _oldStartHunk hunk < 1 || _oldStartHunk hunk > length src + 1 = + Left $ InvalidPatch $ T.pack $ + "_oldStartHunk " ++ show (_oldStartHunk hunk) ++ + " is out of range for source of " ++ show (length src) ++ " lines" + | otherwise = + let startIdx = _oldStartHunk hunk - 1 -- convert to 0-based + before = take startIdx src + target = take (_oldCountHunk hunk) (drop startIdx src) + after = drop (startIdx + _oldCountHunk hunk) src + in case matchLines (_oldStartHunk hunk) (_linesHunk hunk) target of + Left err -> Left err + Right () -> Right (before ++ buildReplacement (_linesHunk hunk) ++ after) + +-- | Verify that Context and Removed lines in the hunk match the target lines in order. +-- Returns HunkMismatch with the 1-based source line number on the first discrepancy. +matchLines :: Int -> [Line] -> [Text] -> Either PatchError () +matchLines lineNo hlines target = go lineNo hlines target + where + go _ [] _ = Right () + go ln (line : rest) src = + case _typeLine line of + -- Added lines do not consume a source line; skip them. + Added -> go ln rest src + -- Context and Removed lines must match the next source line. + Context -> checkLine ln (_contentLine line) rest src + Removed -> checkLine ln (_contentLine line) rest src + + checkLine ln expected rest src = + case src of + [] -> Left $ HunkMismatch ln expected + (s:ss) -> + if s == expected + then go (ln + 1) rest ss + else Left $ HunkMismatch ln expected + +-- | Extract the replacement lines from a hunk: Context and Added lines only. +-- Removed lines are dropped (they are replaced by Added lines). +buildReplacement :: [Line] -> [Text] +buildReplacement = foldr step [] + where + step line acc = + case _typeLine line of + Removed -> acc + _ -> _contentLine line : acc + + +-- --------------------------------------------------------------------------- +-- Fuzzy Patching helpers +-- --------------------------------------------------------------------------- + +-- | Generate candidate 0-based indices in priority order: center first, +-- then alternating outward (center+1, center-1, center+2, center-2, ...). +-- Indices outside [0, maxLen] are excluded. +generateSearchIndices :: Int -> Int -> Int -> [Int] +generateSearchIndices center fuzz maxLen = + filter (\i -> i >= 0 && i <= maxLen) $ + center : concatMap (\d -> [center + d, center - d]) [1 .. fuzz] + +-- | Try each candidate 0-based index in order and return the first one for +-- which matchLines succeeds. Does not apply the hunk; only confirms position. +findFirstMatch :: [Text] -> Hunk -> [Int] -> Maybe Int +findFirstMatch _ _ [] = Nothing +findFirstMatch src hunk (idx:idxs) = + let target = take (_oldCountHunk hunk) (drop idx src) + lineNo = idx + 1 -- matchLines expects a 1-based line number + in case matchLines lineNo (_linesHunk hunk) target of + Right () -> Just idx + Left _ -> findFirstMatch src hunk idxs + +-- | Find the candidate position that produced the deepest (nearest) mismatch. +-- Returns Just (1-based line number, expected text, actual text) for the best candidate, +-- or Nothing when the candidate list is empty or all candidates have empty targets. +-- Used to build diagnostic messages when fuzzy search fails entirely. +findNearestMismatch :: [Text] -> Hunk -> [Int] -> Maybe (Int, Text, Text) +findNearestMismatch src hunk idxs = go idxs Nothing (0 :: Int) + where + -- Walk through candidates, tracking the best (deepest) mismatch seen so far. + go :: [Int] -> Maybe (Int, Text, Text) -> Int -> Maybe (Int, Text, Text) + go [] best _ = best + go (idx:rest) best bestDepth = + let target = take (_oldCountHunk hunk) (drop idx src) + lineNo = idx + 1 + in case probeDepth lineNo (_linesHunk hunk) target 0 of + Nothing -> go rest best bestDepth -- empty target + Just (depth, info) -> + if depth > bestDepth + then go rest (Just info) depth + else go rest best bestDepth + + -- Walk hlines against target, counting how many lines matched before failing. + -- Returns Just (matchDepth, (1-based lineNo, expected, actual)) on mismatch, + -- Nothing when no mismatch was found (full match or empty hlines). + probeDepth :: Int -> [Line] -> [Text] -> Int -> Maybe (Int, (Int, Text, Text)) + probeDepth _ [] _ _ = Nothing + probeDepth ln (line:rest) src' depth = + case _typeLine line of + Added -> probeDepth ln rest src' depth + Context -> checkProbe ln (_contentLine line) rest src' depth + Removed -> checkProbe ln (_contentLine line) rest src' depth + + checkProbe :: Int -> Text -> [Line] -> [Text] -> Int -> Maybe (Int, (Int, Text, Text)) + checkProbe ln expected rest src' depth = + case src' of + [] -> Just (depth, (ln, expected, "")) + (s:ss) -> + if s == expected + then probeDepth (ln+1) rest ss (depth+1) + else Just (depth, (ln, expected, s)) + +-- | Format a hunk header as "@@ -os,oc +ns,nc @@" for use in diagnostic messages. +formatHunkHeader :: Hunk -> String +formatHunkHeader h = + "@@ -" ++ show (_oldStartHunk h) ++ "," ++ show (_oldCountHunk h) + ++ " +" ++ show (_newStartHunk h) ++ "," ++ show (_newCountHunk h) + ++ " @@" + +-- | Fuzzy-aware variant of applyHunk. +-- Takes a 1-based hunk index for diagnostic messages. +-- Uses the delta-corrected _oldStartHunk as a hint and scans ±_FUZZY_RANGE lines +-- for the first position where context lines match, then applies the hunk there. +-- Falls back to a rich InvalidPatch message when no candidate matches. +applyHunkFuzzy :: Int -> [Text] -> Hunk -> Either PatchError [Text] +applyHunkFuzzy hunkIdx src hunk = + let preferredIdx = _oldStartHunk hunk - 1 -- convert 1-based hint to 0-based + candidates = generateSearchIndices preferredIdx _FUZZY_RANGE (length src) + loLine = preferredIdx - _FUZZY_RANGE + hiLine = preferredIdx + _FUZZY_RANGE + -- Count Context+Removed lines declared in the hunk. + actualOldLines = length [ l | l <- _linesHunk hunk + , _typeLine l `elem` [Context, Removed] ] + countMismatch = actualOldLines /= _oldCountHunk hunk + in case findFirstMatch src hunk candidates of + Just bestIdx -> + applyHunk src (hunk { _oldStartHunk = bestIdx + 1 }) -- restore 1-based + Nothing -> + Left $ InvalidPatch $ T.pack $ unlines $ + [ "fuzzy search failed" + , " hunk #" ++ show hunkIdx ++ ": " ++ formatHunkHeader hunk + , " preferred line: " ++ show (_oldStartHunk hunk) + , " searched: " ++ show (max 1 loLine) ++ ".." ++ show (min (length src) hiLine) + , " old lines in hunk (Context+Removed): " ++ show actualOldLines + ++ ", oldCount in header: " ++ show (_oldCountHunk hunk) + ++ if countMismatch then " [MISMATCH]" else "" + ] ++ + case findNearestMismatch src hunk candidates of + Nothing -> [] + Just (ln, exp', act) -> + [ " nearest mismatch at line " ++ show ln ++ ":" + , " expected: " ++ show exp' + , " actual: " ++ show act + ] diff --git a/src/AIAgent/DiffPatch/Unified/ProjectedContext/Context.hs b/src/AIAgent/DiffPatch/Unified/ProjectedContext/Context.hs new file mode 100644 --- /dev/null +++ b/src/AIAgent/DiffPatch/Unified/ProjectedContext/Context.hs @@ -0,0 +1,173 @@ +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE TypeApplications #-} + +-- | ProjectedContext layer: projection functions and AppContext actions. +-- Orchestrates file I/O (via IOFunc) with domain computation. +-- Algorithm functions are in Algorithm.hs; parser functions are in Parser.hs. +-- IO is performed only through liftIOE / the injected IOFunc; no concrete +-- IO implementations are imported here. +module AIAgent.DiffPatch.Unified.ProjectedContext.Context + ( normalize + , detectLineEnding + , restoreLineEnding + , liftIOE + , patchPC + , diffPC + , applyPatchText + , formatPatch + -- Re-exports for backward compatibility (used by tests and other modules) + , module AIAgent.DiffPatch.Unified.ProjectedContext.Algorithm + , module AIAgent.DiffPatch.Unified.ProjectedContext.Parser + ) where + +import qualified Data.Text as T +import Data.Text (Text) +import AIAgent.DiffPatch.Unified.CoreModel.Type +import AIAgent.DiffPatch.Unified.CoreModel.Constant + +import AIAgent.DiffPatch.Unified.ProjectedContext.Algorithm +import AIAgent.DiffPatch.Unified.ProjectedContext.Parser + +-- AppContext imports +import Control.Monad.Reader +import Control.Monad.Except +import qualified Control.Exception.Safe as E +import Data.Default + + +-- | Normalize line endings to LF. +-- Converts CRLF (\r\n) first, then bare CR (\r), to LF (\n). +-- This order is important: handling CR before CRLF would cause \r\n -> \n\n. +normalize :: Text -> Text +normalize = T.replace _CR _LF . T.replace _CRLF _LF + +-- --------------------------------------------------------------------------- +-- Line-ending domain logic (moved from Interface layer) +-- --------------------------------------------------------------------------- + +-- | Detect the dominant line-ending convention in a Text value. +-- CRLF must be tested before CR to avoid misidentifying "\r\n" as bare CR. +detectLineEnding :: Text -> Text +detectLineEnding t + | _CRLF `T.isInfixOf` t = _CRLF + | _CR `T.isInfixOf` t = _CR + | otherwise = _LF + +-- | Restore the original line-ending convention in a Text value. +-- Replaces every LF with the detected line-ending sequence. +-- When the original line-ending is already LF, this is a no-op. +restoreLineEnding :: Text -> Text -> Text +restoreLineEnding le txt + | le == _LF = txt + | otherwise = T.intercalate le (T.splitOn _LF txt) + + +-- --------------------------------------------------------------------------- +-- liftIOE helper +-- --------------------------------------------------------------------------- + +-- | Lift an IO action into AppContext, catching synchronous exceptions +-- and converting them to ExceptT failures. +liftIOE :: IO a -> AppContext a +liftIOE f = liftIO (E.try f) >>= either (throwError . show @E.SomeException) return + + +-- --------------------------------------------------------------------------- +-- formatPatch +-- --------------------------------------------------------------------------- + +-- | Serialize a Patch to unified diff format Text. +-- When _headerPatch is Nothing, the "--- ..." / "+++ ..." header lines are omitted. +-- The hunk header always uses the full form "@@ -s,c +s,c @@" without omitting +-- the count field even when count == 1. +formatPatch :: Patch -> Text +formatPatch p = + headerText <> T.concat (map formatHunk (_hunksPatch p)) + where + headerText = case _headerPatch p of + Nothing -> "" + Just header -> + "--- " <> _oldPathFileHeader header <> "\n" <> + "+++ " <> _newPathFileHeader header <> "\n" + + formatHunk :: Hunk -> Text + formatHunk hunk = + hunkHeader <> T.concat (map formatLine (_linesHunk hunk)) + where + hunkHeader = + "@@ -" <> T.pack (show (_oldStartHunk hunk)) <> "," <> T.pack (show (_oldCountHunk hunk)) <> + " +" <> T.pack (show (_newStartHunk hunk)) <> "," <> T.pack (show (_newCountHunk hunk)) <> + " @@\n" + + formatLine :: Line -> Text + formatLine line = case _typeLine line of + Context -> " " <> _contentLine line <> "\n" + Removed -> "-" <> _contentLine line <> "\n" + Added -> "+" <> _contentLine line <> "\n" + + +-- --------------------------------------------------------------------------- +-- ProjectedContext actions: orchestrate IOFunc + domain computation +-- --------------------------------------------------------------------------- + +-- | Core patch action used by both runPatch' and runPatchFile. +-- Reads the original file, applies the patch text, and writes the result +-- via '_writeIOFunc' (which may target a file or stdout). +-- Line-ending detection and restoration are performed here as domain logic. +patchPC :: FilePath -> String -> AppContext () +patchPC origFile patchText = do + ioFunc <- asks _ioFuncAppData + rawText <- liftIOE $ _readIOFunc ioFunc origFile + let le = detectLineEnding rawText + origText = normalize rawText + result <- either throwError return $ applyPatchText origText (T.pack patchText) + let resultRestored = restoreLineEnding le result + liftIOE $ _writeIOFunc ioFunc origFile resultRestored + +-- | Core diff action. +-- Reads both files, normalises line endings, computes the unified diff, +-- and writes the result via '_writeIOFunc'. +diffPC :: FilePath -> FilePath -> AppContext () +diffPC oldFile newFile = do + ioFunc <- asks _ioFuncAppData + rawOld <- liftIOE $ _readIOFunc ioFunc oldFile + rawNew <- liftIOE $ _readIOFunc ioFunc newFile + let oldText = normalize rawOld + newText = normalize rawNew + edits = myers (T.lines oldText) (T.lines newText) + hunks = buildHunks (_contextLinesDiffOptions (def :: DiffOptions)) edits + result = formatPatch (Patch Nothing hunks) + liftIOE $ _writeIOFunc ioFunc oldFile result + + +-- --------------------------------------------------------------------------- +-- Pure helper: apply a patch text to normalised Text +-- --------------------------------------------------------------------------- + +-- | Parse a unified diff string and apply it to the source Text. +-- The source Text must be LF-normalised before calling this function. +-- Returns the patched Text (LF-terminated) on success, or an error message on failure. +applyPatchText :: T.Text -> T.Text -> Either String T.Text +applyPatchText origText patchTxt + | T.null patchTxt = Right origText + | otherwise = + case parsePatch patchTxt of + Left err -> Left (show err) + Right p -> + let origLines = T.lines origText + in case applyAllHunks origLines (_hunksPatch p) of + Left err -> Left (show err) + Right patched -> Right patched + where + joinLines [] = "" + joinLines ls = T.intercalate _LF ls <> _LF + + applyAllHunks ls hunks = joinLines <$> go 0 1 ls hunks + + go _ _ buf [] = Right buf + go delta hunkIdx buf (h:hs) = + let h' = h { _oldStartHunk = _oldStartHunk h + delta } + delta' = delta + (_newCountHunk h - _oldCountHunk h) + in case applyHunkFuzzy hunkIdx buf h' of + Left err -> Left err + Right buf' -> go delta' (hunkIdx + 1) buf' hs diff --git a/src/AIAgent/DiffPatch/Unified/ProjectedContext/Parser.hs b/src/AIAgent/DiffPatch/Unified/ProjectedContext/Parser.hs new file mode 100644 --- /dev/null +++ b/src/AIAgent/DiffPatch/Unified/ProjectedContext/Parser.hs @@ -0,0 +1,97 @@ +{-# LANGUAGE OverloadedStrings #-} + +-- | ProjectedContext layer: unified diff parser. +-- Contains the Megaparsec-based parser for unified diff format. +-- All functions are pure; no IO is performed in this module. +module AIAgent.DiffPatch.Unified.ProjectedContext.Parser + ( Parser + , parsePatch + , pPatch + , pFileHeader + , pHunk + , pHunkHeader + , pDiffLine + , pRestOfLine + ) where + +import qualified Data.Text as T +import Data.Text (Text) +import AIAgent.DiffPatch.Unified.CoreModel.Type + +-- megaparsec imports +import Data.Void (Void) +import Text.Megaparsec +import Text.Megaparsec.Char +import qualified Text.Megaparsec.Char.Lexer as L + + +type Parser = Parsec Void Text + +-- | Parse a unified diff Text into a Patch. +-- Accepts both the headed format ("--- ..." / "+++ ..." lines present) and +-- the bare format (starting directly with "@@ ... @@"). +-- Returns InvalidPatch on parse failure. +parsePatch :: Text -> Either PatchError Patch +parsePatch input = + case runParser pPatch "" input of + Left err -> Left (InvalidPatch (T.pack (errorBundlePretty err))) + Right p -> Right p + +-- | Top-level parser: optional file header, then one or more hunks. +pPatch :: Parser Patch +pPatch = do + mHeader <- optional pFileHeader + hunks <- some pHunk + eof + return (Patch mHeader hunks) + +-- | Parse the "--- old\n+++ new\n" file header. +pFileHeader :: Parser FileHeader +pFileHeader = do + _ <- string "--- " + oldPath <- pRestOfLine + _ <- string "+++ " + newPath <- pRestOfLine + return (FileHeader oldPath newPath) + +-- | Parse a single hunk: header line followed by diff lines. +pHunk :: Parser Hunk +pHunk = do + (os, oc, ns, nc) <- pHunkHeader + hlines <- many pDiffLine + return (Hunk os oc ns nc hlines) + +-- | Parse "@@ -oldStart[,oldCount] +newStart[,newCount] @@[trailing]\n". +-- The count field is optional; when absent it defaults to 1. +pHunkHeader :: Parser (Int, Int, Int, Int) +pHunkHeader = do + _ <- string "@@ -" + os <- L.decimal + oc <- option 1 (char ',' *> L.decimal) + _ <- string " +" + ns <- L.decimal + nc <- option 1 (char ',' *> L.decimal) + _ <- string " @@" + _ <- pRestOfLine -- consume optional trailing comment and the newline + return (os, oc, ns, nc) + +-- | Parse a single diff line: context (' '), removed ('-'), or added ('+'). +-- As an extension for LLM-generated patch tolerance, a bare newline ('\n') with +-- no leading space is also accepted and treated as an empty context line. +-- The three standard prefixes are tried first; the bare-newline branch is a fallback. +pDiffLine :: Parser Line +pDiffLine = + (char ' ' *> (Line Context <$> pRestOfLine)) + <|> (char '-' *> (Line Removed <$> pRestOfLine)) + <|> (char '+' *> (Line Added <$> pRestOfLine)) + <|> (char '\n' *> return (Line Context "")) + -- ^ Empty context line (LLM-generated patch tolerance). + -- The Unified Diff spec requires " \n" but LLMs often emit bare "\n". + -- Placed last so the three standard prefixes are tried first. + +-- | Consume the rest of the current line (not including the newline) and +-- then consume the newline itself. Returns the line content without '\n'. +pRestOfLine :: Parser Text +pRestOfLine = do + content <- T.pack <$> manyTill anySingle (char '\n') + return content diff --git a/test/AIAgent/DiffPatch/Unified/ApplicationBase/ControlSpec.hs b/test/AIAgent/DiffPatch/Unified/ApplicationBase/ControlSpec.hs new file mode 100644 --- /dev/null +++ b/test/AIAgent/DiffPatch/Unified/ApplicationBase/ControlSpec.hs @@ -0,0 +1,12 @@ +{-# LANGUAGE OverloadedStrings #-} + +-- | Test module for ApplicationBase.Control. +-- Legacy diff/patch (OriginalFile-based) have been removed in PB-0008/CR-01. +-- Remaining coverage is provided by UnifiedSpec (integration tests). +module AIAgent.DiffPatch.Unified.ApplicationBase.ControlSpec (spec) where + +import Test.Hspec + +-- | +spec :: Spec +spec = pure () diff --git a/test/AIAgent/DiffPatch/Unified/ProjectedContext/ContextSpec.hs b/test/AIAgent/DiffPatch/Unified/ProjectedContext/ContextSpec.hs new file mode 100644 --- /dev/null +++ b/test/AIAgent/DiffPatch/Unified/ProjectedContext/ContextSpec.hs @@ -0,0 +1,869 @@ +{-# 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' diff --git a/test/AIAgent/DiffPatch/Unified/UnifiedSpec.hs b/test/AIAgent/DiffPatch/Unified/UnifiedSpec.hs new file mode 100644 --- /dev/null +++ b/test/AIAgent/DiffPatch/Unified/UnifiedSpec.hs @@ -0,0 +1,205 @@ +{-# LANGUAGE OverloadedStrings #-} + +-- | Tests for AIAgent.DiffPatch.Unified. +-- Covers the file I/O API: diff, patch, patchFile. +-- Each test writes a temporary file, calls the target function, and inspects +-- the result and/or captured stdout. +module AIAgent.DiffPatch.Unified.UnifiedSpec (spec) where + +import Test.Hspec +import System.IO.Temp (withSystemTempFile) +import System.IO (hClose) +import qualified Data.ByteString as BS +import qualified Data.Text as T +import qualified Data.Text.Encoding as TE +import Data.Default (def) +import AIAgent.DiffPatch.Unified (diff, patch, patchFile) +import AIAgent.DiffPatch.Unified.ProjectedContext.Context (myers, buildHunks, formatPatch, normalize) +import AIAgent.DiffPatch.Unified.CoreModel.Type (DiffOptions(..), Patch(..), _contextLinesDiffOptions) + +-- --------------------------------------------------------------------------- +-- Helpers +-- --------------------------------------------------------------------------- + +-- | Write a ByteString to a temp file, run the action with the FilePath, +-- then read back the file as a ByteString. +withTempBs :: BS.ByteString -> (FilePath -> IO a) -> IO (a, BS.ByteString) +withTempBs content action = + withSystemTempFile "unified-spec.txt" $ \fp h -> do + hClose h + BS.writeFile fp content + result <- action fp + afterBs <- BS.readFile fp + return (result, afterBs) + +-- | Write a ByteString to a temp file and run an action that only needs the path. +withTempBs_ :: BS.ByteString -> (FilePath -> IO a) -> IO a +withTempBs_ content action = + withSystemTempFile "unified-spec.txt" $ \fp h -> do + hClose h + BS.writeFile fp content + action fp + +-- | Build a unified diff patch String from old/new Text using Context pure functions. +mkPatch :: T.Text -> T.Text -> String +mkPatch old new = + let oldLines = T.lines (normalize old) + newLines = T.lines (normalize new) + edits = myers oldLines newLines + hunks = buildHunks (_contextLinesDiffOptions (def :: DiffOptions)) edits + in T.unpack (formatPatch (Patch Nothing hunks)) + +-- | Encode Text as UTF-8 ByteString (LF line endings assumed in the Text value). +encLf :: T.Text -> BS.ByteString +encLf = TE.encodeUtf8 + +-- | Encode Text as UTF-8 ByteString with CRLF line endings. +encCrlf :: T.Text -> BS.ByteString +encCrlf t = TE.encodeUtf8 (T.intercalate "\r\n" (T.splitOn "\n" t)) + +-- | Replace every LF (0x0a) with CR (0x0d) in a ByteString. +lfToCr :: BS.ByteString -> BS.ByteString +lfToCr = BS.map (\b -> if b == 0x0a then 0x0d else b) + +-- --------------------------------------------------------------------------- +-- Spec +-- --------------------------------------------------------------------------- + +spec :: Spec +spec = do + + -- ========================================================================== + describe "patchFile" $ do + -- ========================================================================== + + -- PF-01: basic LF file patched in place + it "PF-01: LF file - patch applied in place, Right () returned" $ do + let old = "apple\nbanana\ncherry\n" + new = "apple\nblueberry\ncherry\n" + patchTxt = mkPatch old new + origBs = encLf old + (result, afterBs) <- withTempBs origBs $ \fp -> + patchFile fp patchTxt + result `shouldBe` Right () + afterBs `shouldBe` encLf new + + -- PF-02: CRLF file - line endings preserved + it "PF-02: CRLF file - CRLF line endings preserved" $ do + let oldLf = "apple\nbanana\ncherry\n" + newLf = "apple\nblueberry\ncherry\n" + patchTxt = mkPatch oldLf newLf + origBs = encCrlf oldLf + (result, afterBs) <- withTempBs origBs $ \fp -> + patchFile fp patchTxt + result `shouldBe` Right () + afterBs `shouldBe` encCrlf newLf + + -- PF-03: CR-only file - CR line endings preserved + it "PF-03: CR-only file - CR line endings preserved" $ do + let oldLf = "apple\nbanana\ncherry\n" + newLf = "apple\nblueberry\ncherry\n" + patchTxt = mkPatch oldLf newLf + origBs = lfToCr (encLf oldLf) + (result, afterBs) <- withTempBs origBs $ \fp -> + patchFile fp patchTxt + result `shouldBe` Right () + afterBs `shouldBe` lfToCr (encLf newLf) + + -- PF-04: UTF-8 multibyte (Japanese) content + it "PF-04: UTF-8 multibyte (Japanese) content" $ do + let old = "りんご\nばなな\nさくらんぼ\n" + new = "りんご\nブルーベリー\nさくらんぼ\n" + patchTxt = mkPatch old new + origBs = encLf old + (result, afterBs) <- withTempBs origBs $ \fp -> + patchFile fp patchTxt + result `shouldBe` Right () + afterBs `shouldBe` encLf new + + -- PF-05: patch failure returns Left, file unchanged + it "PF-05: patch failure - Left returned and file unchanged" $ do + let origContent = "line1\nline2\nline3\n" + badPatch = "@@ -1,3 +1,3 @@\n WRONG_CONTEXT\n-line2\n+modified\n line3\n" + origBs = encLf origContent + (result, afterBs) <- withTempBs origBs $ \fp -> + patchFile fp badPatch + result `shouldSatisfy` \r -> case r of { Left _ -> True; _ -> False } + afterBs `shouldBe` origBs + + -- PF-06: no-op patch - file unchanged + it "PF-06: no-op patch (identical old/new) - file unchanged" $ do + let content = "apple\nbanana\ncherry\n" + patchTxt = mkPatch content content + origBs = encLf content + (result, afterBs) <- withTempBs origBs $ \fp -> + patchFile fp patchTxt + result `shouldBe` Right () + afterBs `shouldBe` origBs + + -- ========================================================================== + describe "patch" $ do + -- ========================================================================== + + -- PP-01: LF file - Right () returned, file on disk unchanged + it "PP-01: LF file - Right () returned, file on disk not modified" $ do + let old = "apple\nbanana\ncherry\n" + new = "apple\nblueberry\ncherry\n" + patchTxt = mkPatch old new + origBs = encLf old + (result, afterBs) <- withTempBs origBs $ \fp -> + patch fp patchTxt + result `shouldBe` Right () + -- patch writes to stdout, not to disk + afterBs `shouldBe` origBs + + -- PP-02: patch failure - Left returned + it "PP-02: patch failure - Left returned" $ do + let origContent = "line1\nline2\nline3\n" + badPatch = "@@ -1,3 +1,3 @@\n WRONG_CONTEXT\n-line2\n+modified\n line3\n" + origBs = encLf origContent + result <- withTempBs_ origBs $ \fp -> + patch fp badPatch + result `shouldSatisfy` \r -> case r of { Left _ -> True; _ -> False } + + -- PP-03: no-op patch - Right () returned + it "PP-03: no-op patch (identical old/new) - Right () returned" $ do + let content = "apple\nbanana\ncherry\n" + patchTxt = mkPatch content content + origBs = encLf content + (result, _) <- withTempBs origBs $ \fp -> + patch fp patchTxt + result `shouldBe` Right () + + -- ========================================================================== + describe "diff" $ do + -- ========================================================================== + + -- DF-01: two LF files - Right () returned + it "DF-01: two LF files - Right () returned" $ do + let old = "apple\nbanana\ncherry\n" + new = "apple\nblueberry\ncherry\n" + withSystemTempFile "old.txt" $ \oldFp oldH -> + withSystemTempFile "new.txt" $ \newFp newH -> do + hClose oldH + hClose newH + BS.writeFile oldFp (encLf old) + BS.writeFile newFp (encLf new) + result <- diff oldFp newFp + result `shouldBe` Right () + + -- DF-02: identical files - Right () returned (empty diff to stdout) + it "DF-02: identical files - Right () returned" $ do + let content = "apple\nbanana\ncherry\n" + withSystemTempFile "same.txt" $ \fp1 h1 -> + withSystemTempFile "same.txt" $ \fp2 h2 -> do + hClose h1 + hClose h2 + BS.writeFile fp1 (encLf content) + BS.writeFile fp2 (encLf content) + result <- diff fp1 fp2 + result `shouldBe` Right () + + -- DF-03: non-existent file - Left returned + it "DF-03: non-existent file - Left returned (IO error)" $ do + result <- diff "/nonexistent/path/old.txt" "/nonexistent/path/new.txt" + result `shouldSatisfy` \r -> case r of { Left _ -> True; _ -> False } diff --git a/test/Spec.hs b/test/Spec.hs new file mode 100644 --- /dev/null +++ b/test/Spec.hs @@ -0,0 +1,1 @@ +{-# OPTIONS_GHC -F -pgmF hspec-discover #-}