diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -4,10 +4,6 @@ [![Build Status](https://travis-ci.org/bgwines/filediff.svg?branch=master)](https://travis-ci.org/bgwines/filediff) [![Hackage](https://img.shields.io/hackage/v/filediff.svg)](https://hackage.haskell.org/package/filediff) [![Coverage Status](https://coveralls.io/repos/bgwines/filediff/badge.svg?branch=master)](https://coveralls.io/r/bgwines/filediff?branch=master) -## Testing - - cabal configure --enable tests && build && cabal test - ## Found an issue? Don't hesitate to let me know / issue a PR! diff --git a/Tests/test-filediff.hs b/Tests/test-filediff.hs --- a/Tests/test-filediff.hs +++ b/Tests/test-filediff.hs @@ -417,7 +417,7 @@ let listdiff = F.diffLists base comp let applied = F.applyListDiff listdiff base - applied @?= comp + applied @?= Right comp -- file apply tests @@ -430,8 +430,8 @@ createFileWithContents "COMP" compContents fileDiff <- F.diffFiles "BASE" "COMP" - applied <- F.applyToFile fileDiff "BASE" - applied @?= (T.lines . T.pack $ compContents) + applied <- runEitherT (F.applyFileDiff fileDiff "BASE") + applied @?= Right (T.lines . T.pack $ compContents) join $ (liftM2 (@?=)) (readFile "BASE") (readFile "COMP") testFileApplyEdgeCase1 :: Assertion @@ -443,8 +443,8 @@ createFileWithContents "COMP" compContents fileDiff <- F.diffFiles "BASE" "COMP" - applied <- F.applyToFile fileDiff "BASE" - applied @?= (T.lines . T.pack $ compContents) + applied <- runEitherT (F.applyFileDiff fileDiff "BASE") + applied @?= Right (T.lines . T.pack $ compContents) join $ (liftM2 (@?=)) (readFile "BASE") (readFile "COMP") testFileApplyEdgeCase2 :: Assertion @@ -456,8 +456,8 @@ createFileWithContents "COMP" compContents fileDiff <- F.diffFiles "BASE" "COMP" - applied <- F.applyToFile fileDiff "BASE" - applied @?= (T.lines . T.pack $ compContents) + applied <- runEitherT (F.applyFileDiff fileDiff "BASE") + applied @?= Right (T.lines . T.pack $ compContents) join $ (liftM2 (@?=)) (readFile "BASE") (readFile "COMP") -- tests deletion of a file @@ -468,7 +468,7 @@ createFileWithContents "BASE" baseContents fileDiff <- F.diffFiles "BASE" "COMP" - applied <- F.applyToFile fileDiff "BASE" + applied <- runEitherT (F.applyFileDiff fileDiff "BASE") exists <- D.doesFileExist "BASE" assertBool "File should be deleted." (not exists) @@ -482,8 +482,8 @@ fileDiff <- F.diffFiles "BASE" "COMP" - applied <- F.applyToFile fileDiff "BASE" - applied @?= (T.lines . T.pack $ compContents) + applied <- runEitherT (F.applyFileDiff fileDiff "BASE") + applied @?= Right (T.lines . T.pack $ compContents) join $ (liftM2 (@?=)) (readFile "BASE") (readFile "COMP") testFileApplyEdgeCase5 :: Assertion @@ -495,8 +495,8 @@ createFileWithContents "COMP" compContents fileDiff <- F.diffFiles "BASE" "COMP" - applied <- F.applyToFile fileDiff "BASE" - applied @?= (T.lines . T.pack $ compContents) + applied <- runEitherT (F.applyFileDiff fileDiff "BASE") + applied @?= Right (T.lines . T.pack $ compContents) join $ (liftM2 (@?=)) (readFile "BASE") (readFile "COMP") testFileApplyEdgeCase6 :: Assertion @@ -508,10 +508,97 @@ createFileWithContents "COMP" compContents fileDiff <- F.diffFiles "BASE" "COMP" - applied <- F.applyToFile fileDiff "BASE" - applied @?= (T.lines . T.pack $ compContents) + applied <- runEitherT (F.applyFileDiff fileDiff "BASE") + applied @?= Right (T.lines . T.pack $ compContents) join $ (liftM2 (@?=)) (readFile "BASE") (readFile "COMP") +testListDiffApplyFailureDeletionCase :: Assertion +testListDiffApplyFailureDeletionCase = do + let base = "abcdefg" + let faultyBase = "ab*defg" + let comp = "wabxyze" + + let listDiff = F.diffLists base comp + let eitherResult = F.applyListDiff listDiff faultyBase + eitherResult @?= Left "Fatal: couldn't apply list diff (application requires removing an element where the diff calls for a different element residing at that index)." + +testListDiffApplyFailureAdditionCase :: Assertion +testListDiffApplyFailureAdditionCase = do + let base = "abcdefg" + let faultyBase = "abcde" + let comp = "wabxyzefgq" + + let listDiff = F.diffLists base comp + let eitherResult = F.applyListDiff listDiff faultyBase + eitherResult @?= Left "Fatal: couldn't apply list diff (application requires inserting at an index larger than the length of the list to which to apply the diff)." + return () + +testFileDiffApplyFailureDeletionCase :: Assertion +testFileDiffApplyFailureDeletionCase = do + let baseContents = "abcdefg" + let faultyBaseContents = "ab*defg" + let compContents = "wabxyze" + + D.createDirectory "a" + D.createDirectory "b" + createFileWithContents "a/BASE" baseContents + createFileWithContents "a/FAULTY-BASE" faultyBaseContents + createFileWithContents "b/COMP" compContents + + fileDiff <- F.diffFiles "a/BASE" "b/COMP" + eitherResult <- runEitherT (F.applyFileDiff fileDiff "a/FAULTY-BASE") + eitherResult @?= Left "Fatal: couldn't apply list diff (application requires removing an element where the diff calls for a different element residing at that index)." + +testFileDiffApplyFailureAdditionCase :: Assertion +testFileDiffApplyFailureAdditionCase = do + let baseContents = "a\nb\nc\nd\ne\nf\ng" + let faultyBaseContents = "a\nb\nc\nd\ne" + let compContents = "w\na\nb\nx\ny\nz\ne\nf\ng\nq" + + D.createDirectory "a" + D.createDirectory "b" + createFileWithContents "a/BASE" baseContents + createFileWithContents "a/FAULTY-BASE" faultyBaseContents + createFileWithContents "b/COMP" compContents + + fileDiff <- F.diffFiles "a/BASE" "b/COMP" + eitherResult <- runEitherT (F.applyFileDiff fileDiff "a/FAULTY-BASE") + eitherResult @?= Left "Fatal: couldn't apply list diff (application requires inserting at an index larger than the length of the list to which to apply the diff)." + +testDirectoryDiffApplyFailureDeletionCase :: Assertion +testDirectoryDiffApplyFailureDeletionCase = do + let baseContents = "a\nb\nc\nd\ne\nf\ng" + let faultyBaseContents = "a\nb\n*\nd\ne\nf\ng" + let compContents = "wabxyze" + + D.createDirectory "a" + D.createDirectory "faulty-a" + D.createDirectory "b" + createFileWithContents "a/file" baseContents + createFileWithContents "faulty-a/file" faultyBaseContents + createFileWithContents "b/file" compContents + + dirDiff <- F.diffDirectories "a" "b" + eitherResult <- runEitherT (F.applyDirectoryDiff dirDiff "faulty-a") + eitherResult @?= Left "Fatal: couldn't apply list diff (application requires removing an element where the diff calls for a different element residing at that index)." + +testDirectoryDiffApplyFailureAdditionCase :: Assertion +testDirectoryDiffApplyFailureAdditionCase = do + let baseContents = "a\nb\nc\nd\ne\nf\ng" + let faultyBaseContents = "a\nb\nc\nd\ne" + let compContents = "w\na\nb\nx\ny\nz\ne\nf\ng\nq" + + D.createDirectory "a" + D.createDirectory "faulty-a" + D.createDirectory "b" + createFileWithContents "a/file" baseContents + createFileWithContents "faulty-a/file" faultyBaseContents + createFileWithContents "b/file" compContents + + dirDiff <- F.diffDirectories "a" "b" + eitherResult <- runEitherT (F.applyDirectoryDiff dirDiff "faulty-a") + eitherResult @?= Left "Fatal: couldn't apply list diff (application requires inserting at an index larger than the length of the list to which to apply the diff)." + -- directory apply tests testDirApply :: Assertion @@ -532,7 +619,7 @@ createFileWithContents "b/bonly/bfile" "b\nb\nb" diff <- F.diffDirectories "a" "b" - F.applyToDirectory diff "a" + runEitherT (F.applyDirectoryDiff diff "a") -- removing files and removing directories -- also addition of bfile to `a` adds \n @@ -751,6 +838,26 @@ , testCase "Testing same list concatenated with itself (case 2)" testSameListConcatenatedWithIntermediate + + -- can apply? + , testCase + "Testing application failure for list diffs (case 1)" + (runTest testListDiffApplyFailureDeletionCase) + , testCase + "Testing application failure for list diffs (case 2)" + (runTest testListDiffApplyFailureAdditionCase) + , testCase + "Testing application failure for file diffs (case 1)" + (runTest testFileDiffApplyFailureDeletionCase) + , testCase + "Testing application failure for file diffs (case 2)" + (runTest testFileDiffApplyFailureAdditionCase) + , testCase + "Testing application failure for directory diffs (case 1)" + (runTest testDirectoryDiffApplyFailureDeletionCase) + , testCase + "Testing application failure for directory diffs (case 2)" + (runTest testDirectoryDiffApplyFailureAdditionCase) ] main :: IO () diff --git a/filediff.cabal b/filediff.cabal --- a/filediff.cabal +++ b/filediff.cabal @@ -2,7 +2,7 @@ -- documentation, see http://haskell.org/cabal/users-guide/ name: filediff -version: 1.0.0.5 +version: 2.0.0 synopsis: Diffing and patching module description: `filediff` is a Haskell library for creating diffs, and applying diffs to files and directories. homepage: https://github.com/bgwines/filediff diff --git a/src/Filediff.hs b/src/Filediff.hs --- a/src/Filediff.hs +++ b/src/Filediff.hs @@ -9,19 +9,19 @@ -- * files , diffFiles -, applyToFile +, applyFileDiff -- * directories , diffDirectories , diffDirectoriesWithIgnoredSubdirs -, applyToDirectory +, applyDirectoryDiff ) where import Debug.Trace import qualified Data.HashMap as HMap import Control.Concurrent (forkIO) -import Control.Concurrent.Thread as Thread (Result(..)) +import Control.Concurrent.Thread as Thread (Result(..), result) import Control.Concurrent.Thread.Group as ThreadGroup (new, forkIO, wait) import qualified System.IO as IO @@ -30,9 +30,10 @@ import qualified Data.Text as T import qualified Data.Text.IO as TIO -import Data.MemoCombinators.Class (MemoTable, table) import qualified Data.MemoCombinators as Memo +import Data.Either.Combinators + -- function imports import Data.Maybe (isJust, fromJust, catMaybes) @@ -70,7 +71,7 @@ -- file residing at the location specified by the first -- parameter into the second). Throws an exception if either or both of -- the parameters point to a directory, not a file. --- +-- -- Files are allowed to not exist at either or both of the parameters. diffFiles :: FilePath -> FilePath -> IO Filediff diffFiles a b = do @@ -171,43 +172,51 @@ shouldIgnore :: [FilePath] -> FilePath -> Bool shouldIgnore toIgnore filepath = any (flip isPrefix $ filepath) toIgnore --- | /O(n)/. Apply a diff to a file. Throws an exception if the --- application fails. -applyToFile :: Filediff -> FilePath -> IO [Line]--EitherT Error IO () -applyToFile (Filediff _ _ change) filepath = do +-- | /O(n)/. Apply a diff to a file. Returns the fail state if +-- application fails. For more on how diff application can fail, +-- see 'applyListDiff'. +applyFileDiff :: Filediff -> FilePath -> EitherT Error IO [Line] +applyFileDiff (Filediff _ _ change) filepath = do case change of Del _ -> delCase Mod listdiff -> modCase listdiff Add listdiff -> addCase listdiff where - delCase :: IO [Line] - delCase = D.removeFile filepath >> return [] + delCase :: EitherT Error IO [Line] + delCase = liftIO (D.removeFile filepath) >> right [] - addCase :: ListDiff Line -> IO [Line] - addCase listDiff = createFileWithContents filepath "" >> modCase listDiff + addCase :: ListDiff Line -> EitherT Error IO [Line] + addCase listDiff = liftIO (createFileWithContents filepath "") >> modCase listDiff - modCase :: ListDiff Line -> IO [Line] + modCase :: ListDiff Line -> EitherT Error IO [Line] modCase listDiff = do -- Data.Text.IO.readFile is strict, which is what we -- need, here (because of the write right after) - file <- TIO.readFile filepath - let result = applyListDiff listDiff . T.lines $ file - TIO.writeFile filepath (safeInit . T.unlines $ result) -- `init` for trailing \n - return result + file <- liftIO (TIO.readFile filepath) + result <- hoistEither (applyListDiff listDiff . T.lines $ file) + liftIO (TIO.writeFile filepath (safeInit . T.unlines $ result))-- `init` for trailing \n + right result safeInit :: T.Text -> T.Text safeInit x = if T.null x then x else T.init x --- | Applies a `Diff` to a directory. Throws an exception if the --- application fails. -applyToDirectory :: Diff -> FilePath -> IO () -applyToDirectory (Diff filediffs) filepath - = void $ mapMParallelWaitForAll (void . apply) filediffs +-- | Applies a `Diff` to a directory. Returns the fail state if +-- any file application fails, but because of the parallelism in the +-- implementation, all file diffs will be attempted to be applied, so +-- if this fails, your directory will be left in an inconsistent state. +-- For more on how diff application can fail, see 'applyListDiff'. +applyDirectoryDiff :: Diff -> FilePath -> EitherT Error IO [[Line]] +applyDirectoryDiff (Diff filediffs) filepath + = EitherT + . fmap sequence + $ mapMParallelWaitForAll (runEitherT . apply) filediffs >>= mapM Thread.result where - apply :: Filediff -> IO [Line] + apply :: Filediff -> EitherT Error IO [Line] apply diff@(Filediff base compare _) - = applyToFile diff (filepath base) + = applyFileDiff diff (filepath base) +-- | forks the given 'IO' action for each element in the given list, +-- but waits for all to finish before returning. mapMParallelWaitForAll :: (a -> IO b) -> [a] -> IO [Thread.Result b] mapMParallelWaitForAll f list = do group <- ThreadGroup.new @@ -236,35 +245,58 @@ getProgressiveIndicesToAdd sub super = map (\i -> (i, super !! i)) $ nonSubsequenceIndices sub super --- | > λ diffLists "abcdefg" "wabxyze" +-- | Applies a list diff. For example, +-- -- > ListDiff {dels = [(2,'c'),(3,'d'),(5,'f'),(6,'g')], adds = [(0,'w'),(3,'x'),(4,'y'),(5,'z')]} -- > λ applyListDiff it "abcdefg" --- > "wabxyze" +-- > Right "wabxyze" -- --- Throws an exception if the diff can't be applied. -applyListDiff :: forall a. (Eq a) => ListDiff a -> [a] -> [a] -applyListDiff (ListDiff dels adds) - = insertAtProgressiveIndices adds . removeAtIndices dels - where - -- | Best explained by example: - -- | - -- | > λ insertAtProgressiveIndices [(1,'a'),(3,'b')] "def" - -- | > "daebf" - insertAtProgressiveIndices :: [(Int, a)] -> [a] -> [a] - insertAtProgressiveIndices = insertAtProgressiveIndices' 0 +-- Returns a fail state if the diff cannot be applied. This can happen +-- for two reasons: first, the diff calls for a deletion at an index +-- but the element at that index doesn't match the element believed by +-- the to be diff at that index. Second, it can happen if the diff calls +-- for an element to be added at an index too large for the given input. +-- Here are respective examples of inputs that would trigger this case: +-- +-- > let base = "abcdefg" +-- > let faultyBase = "ab*defg" +-- > let comp = "wabxyze" +-- > let listDiff = F.diffLists base comp +-- > F.applyListDiff listDiff faultyBase -- fails +-- +-- and +-- +-- > let base = "abcdefg" +-- > let faultyBase = "abcde" +-- > let comp = "wabxyzefgq" +-- > let listDiff = F.diffLists base comp +-- > F.applyListDiff listDiff faultyBase -- fails +applyListDiff :: forall a. (Eq a) => ListDiff a -> [a] -> Either Error [a] +applyListDiff l@(ListDiff dels adds) list = + removeAtIndices dels list >>= insertAtProgressiveIndices adds - insertAtProgressiveIndices' :: Int -> [(Int, a)] -> [a] -> [a] - insertAtProgressiveIndices' _ [] dest = dest - insertAtProgressiveIndices' curr src@((i,s):src') [] = - s : insertAtProgressiveIndices' (succ curr) src' [] - insertAtProgressiveIndices' curr src@((i,s):src') dest@(d:dest') = - if i == curr - then s : insertAtProgressiveIndices' (succ curr) src' dest - else d : insertAtProgressiveIndices' (succ curr) src dest' +-- | Best explained by example: +-- +-- > λ insertAtProgressiveIndices [(1,'a'),(3,'b')] "def" +-- > Just "daebf" +insertAtProgressiveIndices :: [(Int, a)] -> [a] -> Either Error [a] +insertAtProgressiveIndices = insertAtProgressiveIndices' 0 +insertAtProgressiveIndices' :: Int -> [(Int, a)] -> [a] -> Either Error [a] +insertAtProgressiveIndices' _ [] dest = Right dest +insertAtProgressiveIndices' curr src@((i,s):src') dest = + if i == curr + then (:) s <$> insertAtProgressiveIndices' (succ curr) src' dest + else case dest of + (d:dest') -> (:) d <$> insertAtProgressiveIndices' (succ curr) src dest' + [] -> Left "Fatal: couldn't apply list diff (application requires inserting at an index larger than the length of the list to which to apply the diff)." + -- all functions below are not exposed -- don't hit the memotable if not necessary +-- | A wrapper around `longestCommonSubsequence`. It gives a bit of a +-- performance boost; it avoids hitting the memo table to an extent +-- (exactly how much depends on the arguments). longestCommonSubsequenceWrapper :: forall a. (Eq a) => [a] -> [a] -> [a] longestCommonSubsequenceWrapper xs ys = if xs == ys @@ -340,7 +372,7 @@ -- | When `sub` is a (not necessarily contiguous) subsequence of `super`, -- get the index at which each element of `sub` appears. E.g. --- +-- -- > λ subsequenceIndices "abe" "abcdefg" -- > [0,1,4] subsequenceIndices :: (Eq a) => [a] -> [a] -> [Int] @@ -353,7 +385,7 @@ -- | When `sub` is a (not necessarily contiguous) subsequence of `super`, -- get the indices at which elements of `sub` do *not* appear. E.g. --- +-- -- > λ nonSubsequenceIndices "abe" "abcdefg" -- > [2,3,5,6] nonSubsequenceIndices :: (Eq a) => [a] -> [a] -> [Int] @@ -361,15 +393,15 @@ [0..(length super - 1)] \\ (subsequenceIndices sub super) -- | /O(n)/. `indices` parameter *must* be sorted in increasing order, --- and indices must all exist. Throws an exception if the provided --- list doesn't have those elements at those indices. -removeAtIndices :: forall a. (Eq a) => [(Int, a)] -> [a] -> [a] +-- and indices must all exist. +removeAtIndices :: forall a. (Eq a) => [(Int, a)] -> [a] -> Either Error [a] removeAtIndices dels list = if not matches - then error $ "Fatal: can't apply this diff to this list." - else removeAtIndices' 0 (map fst dels) list + then Left "Fatal: couldn't apply list diff (application requires removing an element where the diff calls for a different element residing at that index)." + else Right (removeAtIndices' 0 (map fst dels) list) where matches :: Bool - matches = all (\(i, ch) -> (list !! i) == ch) dels + matches = all (< length list) (map fst dels) + && all (\(i, ch) -> (list !! i) == ch) dels removeAtIndices' :: Int -> [Int] -> [a] -> [a] removeAtIndices' _ [] xs = xs