filediff 1.0.0.5 → 2.0.0

raw patch · 4 files changed

+209/−74 lines, 4 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• README.md +0/−4
• Tests/test-filediff.hs +122/−15
• filediff.cabal +1/−1
• src/Filediff.hs +86/−54

@@ -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!

@@ -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 ()

@@ -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

@@ -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