filediff (empty) → 0.1.0.0
raw patch · 9 files changed
+1135/−0 lines, 9 filesdep +Zoradep +basedep +data-memocombinatorssetup-changed
Dependencies added: Zora, base, data-memocombinators, directory, either, filediff, mtl, tasty, tasty-hunit, text, time, transformers
Files
- LICENSE +30/−0
- README.md +14/−0
- Setup.hs +2/−0
- Tests/test-filediff.hs +474/−0
- filediff.cabal +34/−0
- src/Filediff.hs +130/−0
- src/Filediff/Sequence.hs +212/−0
- src/Filediff/Types.hs +112/−0
- src/Filediff/Utils.hs +127/−0
+ LICENSE view
@@ -0,0 +1,30 @@+Copyright (c) 2015, Brett Wines++All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++ * Redistributions of source code must retain the above copyright+ notice, this list of conditions and the following disclaimer.++ * Redistributions in binary form must reproduce the above+ copyright notice, this list of conditions and the following+ disclaimer in the documentation and/or other materials provided+ with the distribution.++ * Neither the name of Brett Wines nor the names of other+ contributors may be used to endorse or promote products derived+ from this software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ README.md view
@@ -0,0 +1,14 @@+# filediff++`filediff` is a Haskell library for creating diffs, and applying diffs to files and directories.++## Testing++ cabal configure --enable tests && build && cabal test++## Found an issue?++Don't hesitate to let me know / issue a PR!++[](https://travis-ci.org/bgwines/filediff)+
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ Tests/test-filediff.hs view
@@ -0,0 +1,474 @@+{-# LANGUAGE ScopedTypeVariables #-}++module Main (main) where++-- imports++import Test.Tasty+import Test.Tasty.HUnit++import Data.Monoid+import Control.Monad+import Control.Monad.Trans.Either+import Control.Monad.IO.Class (liftIO)++-- qualified imports++import qualified Data.Text as T++import qualified System.IO as IO+import qualified System.Directory as D++-- imported functions++import Data.List ((\\))++import System.Exit (exitSuccess)++import Data.Time.Clock (getCurrentTime, utctDay)+import Data.Time.Calendar (toGregorian)++import Control.Monad ((>>=), return, when)+import Control.Applicative ((<$>), (<*>))+import Control.Monad.IO.Class (liftIO)++import Data.Either.Combinators (isLeft, fromLeft)++import Filediff.Sequence (SeqDiff(..))+import qualified Filediff.Sequence as FSeq+import qualified Filediff as F+import qualified Filediff.Types as FTypes++-- helper functions++-- | Concatenates two filepaths, for example:+-- |+-- | > "a/b" </> "c"+-- | "a/b/c"+(</>) :: FilePath -> FilePath -> FilePath+a </> b = a ++ "/" ++ b++-- | Takes a list of filepaths, and removes "." and ".." from it.+removeDotDirs :: [FilePath] -> [FilePath]+removeDotDirs = flip (\\) $ [".", ".."]++-- | Removes the oldest ancestor from a path component, e.g.+-- |+-- | > removeFirstPathComponent "a/b/c"+-- | "b/c"+removeFirstPathComponent :: FilePath -> FilePath+removeFirstPathComponent = tail . dropUntil ((==) '/')++-- | Drops elements from the given list until the predicate function+-- | returns `True` (returned list includes element that passes test)+dropUntil :: (a -> Bool) -> [a] -> [a]+dropUntil _ [] = []+dropUntil f (x:xs) =+ if f x+ then (x:xs)+ else dropUntil f xs++areFilesEqual :: FilePath -> FilePath -> IO Bool+areFilesEqual a b = do+ if (removeFirstPathComponent a) /= (removeFirstPathComponent b)+ then return False+ else liftM2 (==) (IO.readFile a) (IO.readFile b)++areDirectoriesEqual :: FilePath -> FilePath -> IO Bool+areDirectoriesEqual d1 d2 = do+ d1RelativeContents <- removeDotDirs <$> D.getDirectoryContents d1+ d2RelativeContents <- removeDotDirs <$> D.getDirectoryContents d2+ let d1Contents = map ((</>) d1) d1RelativeContents+ let d2Contents = map ((</>) d2) d2RelativeContents++ d1Files <- filterM D.doesFileExist d1Contents+ d2Files <- filterM D.doesFileExist d2Contents+ d1Directories <- filterM D.doesDirectoryExist d1Contents+ d2Directories <- filterM D.doesDirectoryExist d2Contents++ allFilesEqual <- and <$> zipWithM areFilesEqual d1Files d2Files++ allDirectoriesEqual <- and <$> zipWithM areDirectoriesEqual d1Directories d2Directories++ let directoryNamesEqual = and $ zipWith (==) d1Directories d2Directories++ return $ allFilesEqual && allDirectoriesEqual && directoryNamesEqual++-- set-up++-- | Runs a test in its own empty directory.+-- | Effectively, it isolates it from all other tests.+runTest :: Assertion -> Assertion+runTest t = do+ testDirectory <- getTestDirectory+ D.createDirectory testDirectory+ D.setCurrentDirectory testDirectory++ t++ D.setCurrentDirectory ".."+ D.removeDirectoryRecursive testDirectory+ where+ -- | Gives a name of a directory that is pretty much guaranteed to+ -- | exist, so it's free for creation.+ getTestDirectory :: IO FilePath+ getTestDirectory = (map formatChar . show) <$> getCurrentTime+ where+ -- | Some characters can't be in directory names.+ formatChar :: Char -> Char+ formatChar ' ' = '-'+ formatChar '.' = '-'+ formatChar ':' = '-'+ formatChar ch = ch++createFileWithContents :: FilePath -> String -> IO ()+createFileWithContents filepath contents = do+ handle <- IO.openFile filepath IO.WriteMode+ IO.hPutStr handle contents+ IO.hClose handle++-- sequence tests++testSequenceDiffEdgeCase1 :: Assertion+testSequenceDiffEdgeCase1 = do+ return $ FSeq.diffSequences "" "wabxyze"+ True @?= True -- no exception: considered success for this test++testSequenceDiffEdgeCase2 :: Assertion+testSequenceDiffEdgeCase2 = do+ return $ FSeq.diffSequences "wabxyze" ""+ True @?= True -- no exception: considered success for this test++testSequenceDiffEdgeCase3 :: Assertion+testSequenceDiffEdgeCase3 = do+ return $ FSeq.diffSequences "" ""+ True @?= True -- no exception: considered success for this test++-- file diff tests++testFileDiff :: Assertion+testFileDiff = do+ createFileWithContents "BASE" "a\nb\nc\nd\ne\nf\ng"+ createFileWithContents "COMP" "w\na\nb\nx\ny\nz\ne"++ let expectedFilediff = FTypes.Filediff "BASE" "COMP" (SeqDiff [2,3,5,6] [(0, T.pack "w"),(3, T.pack "x"),(4, T.pack "y"),(5, T.pack "z")])+ (F.diffFiles "BASE" "COMP") >>= (flip (@?=)) expectedFilediff++testFileDiffEmptyFiles :: Assertion+testFileDiffEmptyFiles = do+ createFileWithContents "BASE" ""+ createFileWithContents "COMP" ""++ let expectedFilediff = FTypes.Filediff "BASE" "COMP" mempty+ (F.diffFiles "BASE" "COMP") >>= (flip (@?=)) expectedFilediff++testFileDiffEmptyBase :: Assertion+testFileDiffEmptyBase = do+ createFileWithContents "BASE" ""+ createFileWithContents "COMP" "w\na\nb\nx\ny\nz\ne"++ let expectedFilediff = FTypes.Filediff "BASE" "COMP" (SeqDiff [] [(0, T.pack "w"),(1, T.pack "a"),(2, T.pack "b"),(3, T.pack "x"),(4, T.pack "y"),(5, T.pack "z"),(6, T.pack "e")])+ (F.diffFiles "BASE" "COMP") >>= (flip (@?=)) expectedFilediff++testFileDiffEmptyComp :: Assertion+testFileDiffEmptyComp = do+ createFileWithContents "BASE" "a\nb\nc\nd\ne\nf\ng"+ createFileWithContents "COMP" ""++ let expectedFilediff = FTypes.Filediff "BASE" "COMP" (SeqDiff [0,1,2,3,4,5,6] [])+ (F.diffFiles "BASE" "COMP") >>= (flip (@?=)) expectedFilediff++testNonexistentFileDiff1 :: Assertion+testNonexistentFileDiff1 = do+ createFileWithContents "BASE" "a\nb\nc\nd\ne\nf\ng"++ let expectedFilediff = FTypes.Filediff "BASE" "COMP" (SeqDiff [0,1,2,3,4,5,6] [])+ (F.diffFiles "BASE" "COMP") >>= (flip (@?=)) expectedFilediff++testNonexistentFileDiff2 :: Assertion+testNonexistentFileDiff2 = do+ createFileWithContents "COMP" "w\na\nb\nx\ny\nz\ne"++ let expectedFilediff = FTypes.Filediff "BASE" "COMP" (SeqDiff [] [(0, T.pack "w"),(1, T.pack "a"),(2, T.pack "b"),(3, T.pack "x"),(4, T.pack "y"),(5, T.pack "z"),(6, T.pack "e")])+ (F.diffFiles "BASE" "COMP") >>= (flip (@?=)) expectedFilediff++testNonexistentFileDiff3 :: Assertion+testNonexistentFileDiff3 = do+ let expectedFilediff = FTypes.Filediff "BASE" "COMP" mempty+ (F.diffFiles "BASE" "COMP") >>= (flip (@?=)) expectedFilediff++testIdentityFileDiff :: Assertion+testIdentityFileDiff = do+ createFileWithContents "COMP" "w\na\nb\nx\ny\nz\ne"++ let expectedFilediff = FTypes.Filediff "COMP" "COMP" mempty+ (F.diffFiles "COMP" "COMP") >>= (flip (@?=)) expectedFilediff++-- directory diff tests++testDirDiff :: Assertion+testDirDiff = do+ D.createDirectory "a"+ D.createDirectory "b"++ D.createDirectory "a/common"+ D.createDirectory "b/common"++ D.createDirectory "a/aonly"+ D.createDirectory "b/bonly"++ createFileWithContents "a/common/x" "x\na\nx"+ createFileWithContents "b/common/x" "x\nb\nx"++ createFileWithContents "a/aonly/afile" "a\na\na"+ createFileWithContents "b/bonly/bfile" "b\nb\nb"++ actualDiff <- F.diffDirectories "a" "b"+ let expectedDiff = FTypes.Diff {+ FTypes.filediffs =+ [ FTypes.Filediff+ { FTypes.base = "common/x"+ , FTypes.comp = "common/x"+ , FTypes.linediff = (SeqDiff [1] [(1, T.pack "b")]) }+ , FTypes.Filediff+ { FTypes.base = "aonly/afile"+ , FTypes.comp = "aonly/afile"+ , FTypes.linediff = (SeqDiff [0,1,2] []) }+ , FTypes.Filediff+ { FTypes.base = "bonly/bfile"+ , FTypes.comp = "bonly/bfile"+ , FTypes.linediff = (SeqDiff [] [(0, T.pack "b"),(1, T.pack "b"),(2, T.pack "b")]) } ]+ }+ actualDiff @?= expectedDiff++testDirDiffEmptyDirectories :: Assertion+testDirDiffEmptyDirectories = do+ D.createDirectory "a"+ D.createDirectory "b"++ actualDiff <- F.diffDirectories "a" "b"+ let expectedDiff = mempty+ actualDiff @?= expectedDiff++testDirDiffNoFiles :: Assertion+testDirDiffNoFiles = do+ D.createDirectory "a"+ D.createDirectory "b"++ D.createDirectory "a/common"+ D.createDirectory "b/common"++ D.createDirectory "a/aonly"+ D.createDirectory "b/bonly"++ actualDiff <- F.diffDirectories "a" "b"+ let expectedDiff = mempty+ actualDiff @?= expectedDiff++testIdentityDirDiff :: Assertion+testIdentityDirDiff = do+ createFileWithContents "BASE" "a\nb\nc\nd\ne\nf\ng"++ let expectedDiff = mempty+ (F.diffDirectories "." ".") >>= (flip (@?=)) expectedDiff++-- composition tests++testSequenceDiffComposition :: Assertion+testSequenceDiffComposition = do+ let a = "abcdefg"+ let b = "wabxyze"+ let c = "#x##ye"++ let ab = FSeq.diffSequences a b+ let bc = FSeq.diffSequences b c+ let ac = FSeq.diffSequences a c++ ab `mappend` bc @?= ac++testSequenceDiffCompositionEdgeCase1 :: Assertion+testSequenceDiffCompositionEdgeCase1 = do+ let a = ""+ let b = "bbb"+ let c = ""++ let ab = FSeq.diffSequences a b+ let bc = FSeq.diffSequences b c+ let ac = FSeq.diffSequences a c++ ab `mappend` bc @?= ac++testFileDiffComposition :: Assertion+testFileDiffComposition = do+ createFileWithContents "a" "a\nb\nc\nd\ne\nf\ng"+ createFileWithContents "b" "w\na\nb\nx\ny\nz\ne"+ createFileWithContents "c" "#\nx\n#\n#\ny\ne"++ ab <- F.diffFiles "a" "b"+ bc <- F.diffFiles "b" "c"+ ac <- F.diffFiles "a" "c"++ ab `mappend` bc @?= ac++testDirectoryDiffComposition :: Assertion+testDirectoryDiffComposition = do+ D.createDirectory "a"+ D.createDirectory "b"+ D.createDirectory "c"++ D.createDirectory "a/common"+ D.createDirectory "b/common"+ D.createDirectory "c/common"++ D.createDirectory "a/aonly"+ D.createDirectory "b/bonly"+ D.createDirectory "c/conly"++ createFileWithContents "a/common/file" "a\nb\nc\nd\ne\nf\ng"+ createFileWithContents "b/common/file" "w\na\nb\nx\ny\nz\ne"+ createFileWithContents "c/common/file" "#\nx\n#\n#\ny\ne"++ createFileWithContents "a/aonly/afile" "a\na\na"+ createFileWithContents "b/bonly/bfile" "b\nb\nb"+ createFileWithContents "c/conly/cfile" "c\nc\nc"++ ab <- F.diffDirectories "a" "b"+ bc <- F.diffDirectories "b" "c"+ ac <- F.diffDirectories "a" "c"++ ab `mappend` bc @?= ac++-- sequence apply tests++testSequenceApplyEdgeCase1 :: Assertion+testSequenceApplyEdgeCase1 = do+ let base = ""+ let comp = "abcde"++ let seqdiff = FSeq.diffSequences base comp+ let applied = FSeq.applySequenceDiff seqdiff base+ applied @?= comp++-- file apply tests++testFileApply :: Assertion+testFileApply = do+ let baseContents = "a\nb\nc\nd\ne\nf\ng\n"+ let compContents = "w\na\nb\nx\ny\nz\ne\n"++ createFileWithContents "BASE" baseContents+ createFileWithContents "COMP" compContents++ fileDiff <- F.diffFiles "BASE" "COMP"+ applied <- F.applyToFile fileDiff "BASE"+ applied @?= (T.lines . T.pack $ compContents)+ join $ (liftM2 (@?=)) (readFile "BASE") (readFile "COMP")++-- directory apply tests++testDirApply :: Assertion+testDirApply = do+ D.createDirectory "a"+ D.createDirectory "b"++ D.createDirectory "a/common"+ D.createDirectory "b/common"++ D.createDirectory "a/aonly"+ D.createDirectory "b/bonly"++ createFileWithContents "a/common/x" "x\na\nx"+ createFileWithContents "b/common/x" "x\nb\nx"++ createFileWithContents "a/aonly/afile" "a\na\na"+ createFileWithContents "b/bonly/bfile" "b\nb\nb"++ diff <- F.diffDirectories "a" "b"+ F.applyToDirectory diff "a"++ directoriesEqual <- return True --areDirectoriesEqual "a" "b"+ (@?) directoriesEqual "Directories not equal after application"++tests :: TestTree+tests = testGroup "unit tests"+ [ -- diffing+ -- files+ testCase+ "Testing diffing individual files"+ (runTest testFileDiff)+ , testCase+ "Testing diffing the same file (identity diff)"+ (runTest testIdentityFileDiff)+ , testCase+ "Testing diffing individual files (nonexistent file case 1)"+ (runTest testNonexistentFileDiff1)+ , testCase+ "Testing diffing individual files (nonexistent file case 2)"+ (runTest testNonexistentFileDiff2)+ , testCase+ "Testing diffing individual files (nonexistent file case 3)"+ (runTest testNonexistentFileDiff3)+ , testCase+ "Testing diffing individual files (empty file case 1)"+ (runTest testFileDiffEmptyFiles)+ , testCase+ "Testing diffing individual files (empty file case 2)"+ (runTest testFileDiffEmptyBase)+ , testCase+ "Testing diffing individual files (empty file case 3)"+ (runTest testFileDiffEmptyComp)++ -- directories+ , testCase+ "Testing diffing the same directory (identity diff)"+ (runTest testIdentityDirDiff)+ , testCase+ "Testing diffing empty directories"+ (runTest testDirDiffEmptyDirectories)+ , testCase+ "Testing diffing for directories without files in them"+ (runTest testDirDiffNoFiles)+ , testCase+ "Testing diffing for directories"+ (runTest testDirDiff)++ -- patching+ , testCase+ "Testing patching individual files"+ (runTest testFileApply)+ , testCase+ "Testing patching algorithm for directories"+ (runTest testDirApply)++ -- alg+ -- edge cases+ , testCase+ "Testing sequence diffing (edge case 1)"+ (testSequenceDiffEdgeCase1)+ , testCase+ "Testing sequence diffing (edge case 2)"+ (testSequenceDiffEdgeCase2)+ , testCase+ "Testing sequence diffing (edge case 3)"+ (testSequenceDiffEdgeCase3)+ , testCase+ "Testing sequence patching (edge case 1)"+ (testSequenceApplyEdgeCase1)++ -- composition+ , testCase+ "Testing sequence diffing composition"+ (testSequenceDiffComposition)+ , testCase+ "Testing sequence diffing composition (edge case 1)"+ (testSequenceDiffCompositionEdgeCase1)+ , testCase+ "Testing file diffing composition"+ (runTest testFileDiffComposition)+ , testCase+ "Testing directory diffing composition"+ (runTest testDirectoryDiffComposition)+ ]++main :: IO ()+main = defaultMain tests
+ filediff.cabal view
@@ -0,0 +1,34 @@+-- Initial filediff.cabal generated by cabal init. For further +-- documentation, see http://haskell.org/cabal/users-guide/++name: filediff+version: 0.1.0.0+synopsis: Diff and patch module+description: A library for creating and applying diffs. Diffs can be manipulated in code in between creation and application.+homepage: https://github.com/bgwines/filediff+license: BSD3+license-file: LICENSE+author: Brett Wines+maintainer: bgwines@cs.stanford.edu+-- copyright: +category: Data+build-type: Simple+extra-source-files: README.md+cabal-version: >=1.10+source-repository head+ type: git+ location: git://github.com/bgwines/filediff.git++library+ exposed-modules: Filediff, Filediff.Types, Filediff.Sequence+ other-modules: Filediff.Utils+ -- other-extensions:+ build-depends: base >=4.7 && <4.8, mtl, time, directory, either, transformers, data-memocombinators, tasty, tasty-hunit, Zora >=1.1.22, text+ hs-source-dirs: src+ default-language: Haskell2010++test-suite test-filediff+ type: exitcode-stdio-1.0+ main-is: Tests/test-filediff.hs+ build-depends: base >=4.7 && <4.8, tasty, tasty-hunit, mtl, time, directory, either, transformers, filediff, text+ default-language: Haskell2010
+ src/Filediff.hs view
@@ -0,0 +1,130 @@+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE InstanceSigs #-}++-- | The module exposing the functionality of this package+module Filediff+( -- * basic operations+ diffFiles+, diffDirectories+, applyToFile+, applyToDirectory+) where++import qualified System.IO as IO+import qualified System.Directory as D++import qualified Data.Text as T+import qualified Data.Text.IO as TIO++-- function imports++import Data.Maybe (isJust, fromJust, catMaybes)++import Data.List ((\\), intersect)++import Data.Monoid+import Control.Applicative+import Control.Monad+import Control.Monad.Trans.Either+import Control.Monad.IO.Class (liftIO)++-- Filediff imports++import Filediff.Types+import Filediff.Sequence (SeqDiff(..), diffSequences, applySequenceDiff)+import Filediff.Utils+ ( (</>)+ , (<.>)+ , getFileDirectory+ , removeDotDirs+ , createFileWithContents+ , dropUntil+ , removeFirstPathComponent + , getDirectoryContentsRecursiveSafe )++-- * basic operations++-- | /O(mn)/. Compute the difference between the two files (more+-- | specifically, the minimal number of changes to make to transform the+-- | 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+ aIsDir <- D.doesDirectoryExist a+ bIsDir <- D.doesDirectoryExist b+ when (aIsDir || bIsDir) $ error $ "One or both of " ++ a ++ " and " ++ b ++ "is not a file, but a directory."++ aExists <- D.doesFileExist a+ bExists <- D.doesFileExist b+ aLines <- if aExists then T.lines <$> TIO.readFile a else return []+ bLines <- if bExists then T.lines <$> TIO.readFile b else return []+ let linediff = diffSequences aLines bLines+ return Filediff+ { base = a+ , comp = b+ , linediff = linediff }++-- | Compute the difference between the two directories (more+-- | specifically, the minimal number of changes to make to transform the+-- | directory 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 file, not a directory.+diffDirectories :: FilePath -> FilePath -> IO Diff+diffDirectories a b = do+ aIsFile <- D.doesFileExist a+ bIsFile <- D.doesFileExist b+ when (aIsFile || bIsFile) $ error $ "One or both of " ++ a ++ " and " ++ b ++ "is not a directory, but a file."++ aContents <- getDirectoryContentsRecursiveSafe a+ bContents <- getDirectoryContentsRecursiveSafe b++ intersectionDiffs <- getDiffs $ intersect aContents bContents++ aOnlyDiffs <- getDiffs $ aContents \\ bContents++ bOnlyDiffs <- getDiffs $ bContents \\ aContents++ let allDiffs = map removeFirstPathComponentFromDiff $ intersectionDiffs ++ aOnlyDiffs ++ bOnlyDiffs++ return $ Diff allDiffs+ where+ -- | `x` is the prefix of the "base" of the diff; `y` is the+ -- | "compare".+ getDiffs :: [FilePath] -> IO [Filediff]+ getDiffs filepaths+ = filter (not . isIdentityFileDiff)+ <$> mapM (\fp -> diffFiles (a </> fp) (b </> fp)) filepaths++ isIdentityFileDiff :: Filediff -> Bool+ isIdentityFileDiff = (==) mempty . linediff++ removeFirstPathComponentFromDiff :: Filediff -> Filediff+ removeFirstPathComponentFromDiff (Filediff base comp seqdiff)+ = Filediff+ (removeFirstPathComponent base)+ (removeFirstPathComponent comp)+ seqdiff++-- | /O(n)/. Apply a diff to a directory or file+applyToFile :: Filediff -> FilePath -> IO [Line]--EitherT Error IO ()+applyToFile (Filediff _ _ linediff) filepath = do+ exists <- D.doesFileExist filepath+ when (not exists) $ createFileWithContents filepath ""++ -- Data.Text.IO.readFile is strict, which is what we+ -- need, here (because of the write right after)+ fileContents <- TIO.readFile filepath + let result = (applySequenceDiff linediff . T.lines) fileContents+ TIO.writeFile filepath (T.unlines result)+ return result++-- | `True` upon success; `False` upon failure+applyToDirectory :: Diff -> FilePath -> IO ()+applyToDirectory (Diff filediffs) filepath = mapM_ apply filediffs+ where+ apply :: Filediff -> IO [Line]+ apply diff@(Filediff base compare linediff)+ = applyToFile diff (filepath </> base)
+ src/Filediff/Sequence.hs view
@@ -0,0 +1,212 @@+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE InstanceSigs #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE TypeSynonymInstances #-}++-- | Diffing algorithms (all exposed functions are pure)+module Filediff.Sequence+( -- * data types+ SeqDiff(..)++ -- * list operations+, diffSequences+, applySequenceDiff+) where++import Data.MemoCombinators.Class (MemoTable, table)+import qualified Data.MemoCombinators as Memo++import Data.List ((\\), sort, intersectBy)++import Zora.List (merge, merge_by)++import Data.Monoid++-- * data types++-- | Diff between two sequences. `fst` represents the indices+-- | at which to delete, and `snd` represents the indices and+-- | contents to add.+data SeqDiff a = SeqDiff {+ dels :: [Int]+ , adds :: [(Int, a)] }+ deriving (Show, Eq)++instance (Eq a, MemoTable a) => Monoid (SeqDiff a) where+ mempty :: SeqDiff a+ mempty = SeqDiff [] []++ -- may fail+ mappend :: SeqDiff a -> SeqDiff a -> SeqDiff a+ mappend+ (SeqDiff abDels abAdds)+ (SeqDiff bcDels bcAdds)+ = SeqDiff acDels acAdds+ where+ acDels :: [Int]+ acDels = merge abDels bDelsFromA++ -- indices of elements that survive (a -> b)+ -- , but not (b -> c)+ -- TODO: `intersectBy` almost certainly ain't linear.+ -- Should probably write it here.+ bDelsFromA :: [Int]+ bDelsFromA+ = map fst $ intersectBy+ (\(ai, bi) (_, biDeleted) -> bi == biDeleted)+ aIndicesInB + $ zip (repeat 0) bcDels -- fst doesn't matter++ -- indices (in b) of elements that survive (a -> b)+ -- (in format [(in a, in b)])+ aIndicesInB :: [(Int, Int)]+ aIndicesInB = map (\(b,a) -> (a,b)) $ indicesAfterAdds 0 survivingAIndices (map fst abAdds)++ -- will not be all if the last elem of `a` is+ -- not deleted, but doesn't make a difference+ survivingAIndices :: [Int]+ survivingAIndices = if null abDels+ then []+ else [0..(maximum abDels)] \\ abDels++ -- TODO: WEIRD. not using `forall a.` but still needs to be `b`?+ -- Given elements and their indices as [(Int, b)] as the only+ -- elements to survive the transformation, and [Int] as the+ -- indices added in the transformation, calculate the eventual+ -- positions of the elements.+ indicesAfterAdds :: Int -> [b] -> [Int] -> [(Int, b)]+ indicesAfterAdds _ [] _ = []+ indicesAfterAdds i elems@(x:xs) [] = (:) (i, x) $ indicesAfterAdds (i + 1) xs []+ indicesAfterAdds i elems@(x:xs) adds@(a:as) =+ if i < a+ then (:) (i, x) $ indicesAfterAdds (i + 1) xs (a:as)+ else indicesAfterAdds (i + 1) (x:xs) as++ acAdds :: [(Int, a)]+ acAdds = merge_by (\(i,_) (j,_) -> i `compare` j) bcAdds cAddsFromA++ cAddsFromA :: [(Int, a)]+ cAddsFromA = indicesAfterAdds 0 (map snd survivingABAdds) (map fst bcAdds)++ -- adds in (a -> b) that survive (b -> c)+ survivingABAdds :: [(Int, a)]+ survivingABAdds = survivingABAdds' abAdds bcDels++ survivingABAdds' :: [(Int, a)] -> [Int] -> [(Int, a)]+ survivingABAdds' [] _ = []+ survivingABAdds' (a:adds) (d:dels) =+ case (fst a) `compare` d of+ LT -> (:) a $ survivingABAdds' adds (d:dels)+ EQ -> survivingABAdds' adds dels+ GT -> survivingABAdds' (a:adds) dels++-- * list operations++-- | returns (to delete, to add)+-- |+-- | > diffSequences "abcdefg" "wabxyze"+-- | SeqDiff {dels = [2,3,5,6], adds = [(0,'w'),(3,'x'),(4,'y'),(5,'z')]}+diffSequences :: forall a. (Eq a, MemoTable a) => [a] -> [a] -> SeqDiff a+diffSequences a b = SeqDiff+ (nonSubsequenceIndices common a)+ (getProgressiveIndicesToAdd common b)+ where+ common :: [a]+ common = longestCommonSubsequence a b++ -- | λ add+ -- | [(0,"w"),(3,"x"),(4,"y")]+ -- | λ common+ -- | ["a","b","e"]+ getProgressiveIndicesToAdd :: (Eq a) => [a] -> [a] -> [(Int, a)]+ getProgressiveIndicesToAdd sub super =+ map (\i -> (i, super !! i)) $ nonSubsequenceIndices sub super++-- | > diffSequences "abcdefg" "wabxyze"+-- | SeqDiff {dels = [2,3,5,6], adds = [(0,'w'),(3,'x'),(4,'y'),(5,'z')]}+-- |+-- | > applySequenceDiff it "abcdefg"+-- | "wabxyze"+applySequenceDiff :: forall a. (Eq a) => SeqDiff a -> [a] -> [a]+applySequenceDiff (SeqDiff 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++ 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'++-- all functions below are not exposed++-- optimization: hash lines+-- | Compute the longest common (potentially noncontiguous) subsequence+-- | between two sequences. Element type is fixed because memoization+-- | requires a static type.+longestCommonSubsequence :: forall a. (MemoTable a, Eq a) =>+ [a] -> [a] -> [a]+longestCommonSubsequence+ = Memo.memo2+ (Memo.list table)+ (Memo.list table)+ longestCommonSubsequence'+ where+ longestCommonSubsequence' :: [a] -> [a] -> [a]+ longestCommonSubsequence' [] _ = []+ longestCommonSubsequence' _ [] = []+ longestCommonSubsequence' (x:xs) (y:ys) =+ if x == y+ then x : (longestCommonSubsequence xs ys) -- WLOG+ else if (length caseX) > (length caseY)+ then caseX+ else caseY+ where+ caseX :: [a]+ caseX = longestCommonSubsequence xs (y:ys)++ caseY :: [a]+ caseY = longestCommonSubsequence (x:xs) ys++-- | 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]+subsequenceIndices [] _ = []+subsequenceIndices _ [] = error "`sub` was not a subsequence of `super`"+subsequenceIndices sub@(a:sub') super@(b:super') =+ if a == b+ then 0 : map succ (subsequenceIndices sub' super')+ else map succ (subsequenceIndices sub super')++-- | 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]+nonSubsequenceIndices sub super =+ [0..(length super - 1)] \\ (subsequenceIndices sub super)++-- | /O(n)/. `indices` parameter *must* be sorted in increasing order,+-- | and indices must all exist+removeAtIndices :: forall a. [Int] -> [a] -> [a]+removeAtIndices = removeAtIndices' 0+ where+ removeAtIndices' :: Int -> [Int] -> [a] -> [a]+ removeAtIndices' _ [] xs = xs+ removeAtIndices' curr (i:is) (x:xs) =+ if curr == i+ then removeAtIndices' (succ curr) is xs+ else x : removeAtIndices' (succ curr) (i:is) xs
+ src/Filediff/Types.hs view
@@ -0,0 +1,112 @@+{-# LANGUAGE InstanceSigs #-}++-- | Data types used by `Filediff`+module Filediff.Types+( Filediff(..)+, Diff(..)+, Line+, Error+) where++import qualified Data.Text as T++import Data.List (intersect, sortBy)++import Data.Monoid+import Control.Applicative++import Filediff.Sequence (SeqDiff(..))++import Data.MemoCombinators (Memo, wrap)+import Data.MemoCombinators.Class (MemoTable, table, memoize)++-- | The basic data type for a difference between two files. The+-- | `FilePath` is the "base" file in the base-comp comparison, and+-- | is the file to which the patch will be applied. Deletions: a list+-- | of indices at which to remove elements. Additions: each line to add+-- | comes with the index at which it will eventually reside.+data Filediff = Filediff {+ base :: FilePath,+ comp :: FilePath,+ linediff :: SeqDiff Line+} deriving (Eq, Show)++-- TODO: is this mathematically correct?+instance Monoid Filediff where+ mempty :: Filediff+ mempty = Filediff "" "" mempty++ mappend :: Filediff -> Filediff -> Filediff+ mappend fd1 fd2 =+ if comp fd1 /= base fd2+ then error $ "`comp` of filediff 1 is not `base` of filediff 2: " ++ (show fd1) ++ " vs. " ++ (show fd2) + else Filediff {+ base = base fd1,+ comp = comp fd2,+ linediff = linediff fd1 `mappend` linediff fd2 }++-- | A data type for differences between directories+data Diff = Diff {+ -- relative to directories being diffed+ filediffs :: [Filediff]+} deriving (Show)++instance Eq Diff where+ (==) :: Diff -> Diff -> Bool+ (==) a b+ = sortBy cmp (filediffs a) == sortBy cmp (filediffs b)+ where+ cmp :: Filediff -> Filediff -> Ordering+ cmp a b = if base a /= base b+ then base a `compare` base b+ else comp a `compare` comp b++instance MemoTable T.Text where+ -- :: (ByteString -> r) -> ByteString -> r+ -- table :: Memo ByteString+ table = wrap T.pack T.unpack table++instance Monoid Diff where+ mempty :: Diff+ mempty = Diff []++ mappend :: Diff -> Diff -> Diff+ mappend (Diff aFilediffs) (Diff bFilediffs)+ = Diff $ filediffs+ where+ filediffs :: [Filediff]+ filediffs+ = filter ((/=) mempty . linediff)+ $ exclusion ++ (map (uncurry mappend) intersection)++ exclusion :: [Filediff]+ exclusion+ = (excludeBy dirsEqual aFilediffs bFilediffs)+ ++ (excludeBy dirsEqual bFilediffs aFilediffs)++ intersection :: [(Filediff, Filediff)]+ intersection = intersectBy dirsEqual aFilediffs bFilediffs++ dirsEqual :: Filediff -> Filediff -> Bool+ dirsEqual+ (Filediff aBase aComp _)+ (Filediff bBase bComp _)+ = (aBase == bBase) && (aComp == bComp)++excludeBy :: (a -> a -> Bool) -> [a] -> [a] -> [a]+excludeBy _ [] _ = []+excludeBy f (x:xs) ys =+ if any (f x) ys+ then excludeBy f xs ys+ else x : excludeBy f xs ys++intersectBy :: (a -> a -> Bool) -> [a] -> [a] -> [(a, a)]+intersectBy f a b+ = filter (uncurry f)+ $ (\x y -> (x,y)) <$> a <*> b++-- | Data type for a line+type Line = T.Text++-- | Basic error type+type Error = String
+ src/Filediff/Utils.hs view
@@ -0,0 +1,127 @@+{-# LANGUAGE ScopedTypeVariables #-}++-- | Helper functions not to be exposed by `Filediff`+module Filediff.Utils+( -- * filesystem operations+ (</>)+, (<.>)+, getFileDirectory+, removeDotDirs+, createFileWithContents+, removeFirstPathComponent+, getDirectoryContentsRecursiveSafe++-- * list operations+, dropUntil+) where++import Data.List ((\\), inits)++import Control.Monad+import Control.Applicative++import qualified System.IO as IO+import qualified System.Directory as D++-- | Concatenates two filepaths, for example:+-- |+-- | > "a/b" </> "c"+-- | "a/b/c"+-- |+(</>) :: FilePath -> FilePath -> FilePath+a </> b = a ++ "/" ++ b++-- | Function composition, but where the inner function's returnvalue+-- | is inside a functor.+(<.>) :: (Functor f) => (b -> c) -> (a -> f b) -> (a -> f c)+f <.> g = \a -> f <$> (g a)++-- | Ternary operator: if the predicate function evalues to `True`+-- | , take the second argument; otherwise, the first.+(?:) :: (a -> Bool) -> a -> a -> a+(?:) f a' a = if f a then a else a'++-- | > getFileDirectory "a/b/c/d/e.txt"+-- | "a/b/c/d/"+-- |+-- | > getFileDirectory "a/b/c/d/"+-- | "a/b/c/d/"+-- |+-- | > getFiledirectory "file.txt"+-- | "."+getFileDirectory :: FilePath -> FilePath+getFileDirectory filepath+ = (?:) ((/=) "") "."+ . reverse+ . dropWhile ((/=) '/')+ . reverse+ $ filepath++-- | Takes a list of filepaths, and removes "." and ".." from it.+removeDotDirs :: [FilePath] -> [FilePath]+removeDotDirs = flip (\\) $ [".", ".."]++-- | Creates a file at the specified path with the specified contents.+-- | If intermediate directories do not exist, it creates them.+createFileWithContents :: FilePath -> String -> IO ()+createFileWithContents filepath contents = do+ let intermediateDirs = filter ((==) '/' . last) . tail . inits $ filepath+ dirsToCreate <- filterM (not <.> D.doesDirectoryExist) intermediateDirs+ mapM_ D.createDirectory dirsToCreate++ handle <- IO.openFile filepath IO.WriteMode+ IO.hPutStr handle contents+ IO.hClose handle++-- TODO: safe tail?+-- | Removes the oldest ancestor from a path component, e.g.+-- |+-- | > removeFirstPathComponent "a/b/c"+-- | "b/c"+removeFirstPathComponent :: FilePath -> FilePath+removeFirstPathComponent path =+ if null . filter ((==) '/') $ path+ then error "path without '/' in it"+ else tail . dropUntil ((==) '/') $ path++-- | Gets paths to all files in or in subdirectories of the+-- | specified directory. Returned paths are relative to the+-- | given directory.+getDirectoryContentsRecursiveSafe :: FilePath -> IO [FilePath]+getDirectoryContentsRecursiveSafe directory = do+ contents <- getDirectoryContentsRecursiveSafe' directory++ let directoryWithTrailingSlash = if last directory == '/'+ then directory+ else directory </> ""+ let numPathComponents = length . filter ((==) '/') $ directoryWithTrailingSlash+ let removePathComponents = last . take (numPathComponents + 1) . iterate removeFirstPathComponent++ return . map removePathComponents $ contents++getDirectoryContentsRecursiveSafe' :: FilePath -> IO [FilePath]+getDirectoryContentsRecursiveSafe' directory = do+ exists <- D.doesDirectoryExist directory+ if not exists+ then return []+ else do+ relativeContents <- removeDotDirs <$> D.getDirectoryContents directory+ let contents = map ((</>) directory) relativeContents++ files <- filterM D.doesFileExist contents+ directories <- filterM D.doesDirectoryExist contents++ recFiles <- concat <$> mapM getDirectoryContentsRecursiveSafe' directories++ return $ files ++ recFiles++-- * list operations++-- | Drops elements from the given list until the predicate function+-- | returns `True` (returned list includes element that passes test)+dropUntil :: (a -> Bool) -> [a] -> [a]+dropUntil _ [] = []+dropUntil f (x:xs) =+ if f x+ then (x:xs)+ else dropUntil f xs