diff3 0.2 → 0.2.0

raw patch · 3 files changed

+50/−57 lines, 3 filesdep ~basePVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependency ranges changed: base

API changes (from Hackage documentation)

Files

• diff3.cabal +2/−2
• src/Data/Algorithm/Diff3.hs +47/−54
• test/properties.hs +1/−1

@@ -1,5 +1,5 @@ name:                diff3-version:             0.2+version:             0.2.0 synopsis:            Perform a 3-way difference of documents homepage:            http://github.com/ocharles/diff3.git license:             BSD3@@ -19,7 +19,7 @@  library   exposed-modules:     Data.Algorithm.Diff3-  build-depends:       base ==4.6.*, Diff >= 0.2+  build-depends:       base < 5, Diff >=0.2   hs-source-dirs: src   ghc-options: -Wall -fwarn-tabs -funbox-strict-fields -O2                -fno-warn-orphans -fno-warn-unused-do-bind

@@ -1,36 +1,22 @@ {-| An implementation of a 3-way merge algorithm. -} module Data.Algorithm.Diff3 (Hunk(..), diff3, merge) where -import Data.Algorithm.Diff import Data.Monoid (Monoid, mempty, mappend) +import qualified Data.Algorithm.Diff as Diff+ -------------------------------------------------------------------------------- -- | A hunk is a collection of changes that occur in a document. A hunk can be -- some changes only in A, only in B, in both A & B (equally), or conflicting--- between A, B and the original document.  All hunks take 3 constructors, which--- are, in order - the elements in the left document, the original document, and--- the right document. This order matches the order of parameters to 'diff3'.-data Hunk a = LeftChange [a]-            | RightChange [a]-            | Unchanged [a]-            | Conflict [a] [a] [a]+-- between A, B and the original document.+data Hunk a = ChangedInA [a] | ChangedInB [a] | Both [a] | Conflict [a] [a] [a]   deriving (Eq, Show) -instance Functor Hunk where-  fmap f (LeftChange ls) = LeftChange (map f ls)-  fmap f (RightChange rs) = RightChange (map f rs)-  fmap f (Unchanged os) = Unchanged (map f os)-  fmap f (Conflict ls os rs) = Conflict (map f ls) (map f os) (map f rs)  ----------------------------------------------------------------------------------- | Perform a 3-way diff against 2 documents and the original document. This--- returns a list of triples, where each triple contains all parts of the--- original document that either agree on 2 or 3 sides, or conflict. This can be--- considered a \'low level\' interface to the 3-way diff algorithm - you may be--- more interested in 'merge' and 'toHunks', which provide a higher level--- interface.+-- | Perform a 3-way diff against 2 documents and the original document. diff3 :: Eq a => [a] -> [a] -> [a] -> [Hunk a]-diff3 a o b = step (getDiff o a) (getDiff o b)+diff3 a o b = step (Diff.getDiff o a) (Diff.getDiff o b)   where     step [] [] = []     step [] ob = toHunk [] ob@@ -47,49 +33,59 @@   where     go [] = Just []     go ((Conflict _ _ _):_) = Nothing-    go ((LeftChange l):t) = fmap (l ++) $ go t-    go ((RightChange r):t) = fmap (r ++) $ go t-    go ((Unchanged o):t) = fmap (o ++) $ go t+    go ((ChangedInA as):t) = fmap (as ++) $ go t+    go ((ChangedInB bs):t) = fmap (bs ++) $ go t+    go ((Both xs):t) = fmap (xs ++) $ go t   ---------------------------------------------------------------------------------toHunk :: [Diff a] -> [Diff a] -> [Hunk a]+toHunk :: [Diff.Diff a] -> [Diff.Diff a] -> [Hunk a] toHunk [] [] = mempty-toHunk a  [] = [LeftChange $ takeSecond a]-toHunk [] b  = [RightChange $ takeSecond b]+toHunk a  [] = return $ ChangedInA $ map get a+toHunk [] b  = return $ ChangedInB $ map get b toHunk a  b-  | all isB a && all isB b = [Unchanged $ takeFirst a]-  | all isB a = [RightChange $ takeSecond b]-  | all isB b = [LeftChange $ takeSecond a]-  | otherwise = [Conflict (takeSecond a) (takeFirst a) (takeSecond b)]+  | all isB a && all isB b = return $ Both $ map get $ filter isA a+  | all isB a = return $ ChangedInB $ map get $ filter isA b+  | all isB b = return $ ChangedInA $ map get $ filter isA a+  | otherwise = return $ Conflict (map get $ filter isA a)+                                  (map get $ filter isO a)+                                  (map get $ filter isA b) -takeSecond :: [Diff a] -> [a]-takeSecond []            = []-takeSecond (Second x:xs) = x:takeSecond xs-takeSecond (Both x _:xs) = x:takeSecond xs-takeSecond (_:xs)        = takeSecond xs+--------------------------------------------------------------------------------+get :: Diff.Diff t -> t+get (Diff.First x) = x+get (Diff.Second x) = x+get (Diff.Both x _) = x -takeFirst :: [Diff a] -> [a]-takeFirst []            = []-takeFirst (First x :xs) = x:takeFirst xs-takeFirst (Both x _:xs) = x:takeFirst xs-takeFirst (_:xs)        = takeFirst xs+--------------------------------------------------------------------------------+isA :: Diff.Diff t -> Bool+isA (Diff.First _) = False+isA _ = True+{-# INLINE isA #-} -isB :: Diff a -> Bool-isB (Both _ _) = True+--------------------------------------------------------------------------------+isO :: Diff.Diff t -> Bool+isO (Diff.Second _) = False+isO _ = True+{-# INLINE isO #-}+++--------------------------------------------------------------------------------+isB :: Diff.Diff t -> Bool+isB (Diff.Both _ _) = True isB _ = False {-# INLINE isB #-}  ---------------------------------------------------------------------------------shortestMatch :: [Diff a] -> [Diff a] -> ([Hunk a], [Diff a], [Diff a])+shortestMatch :: [Diff.Diff a] -> [Diff.Diff a] -> ([Hunk a], [Diff.Diff a], [Diff.Diff a]) shortestMatch oa ob = go oa ob [] []   where-    go (x@(Both _ _):xs) (y@(Both _ _):ys) accX accY = go xs ys (accX ++ [x]) (accY ++ [y])+    go (x@(Diff.Both _ _):xs) (y@(Diff.Both _ _):ys) accX accY = go xs ys (accX ++ [x]) (accY ++ [y])     go xs ys accX accY = (toHunk accX accY, xs, ys)   ---------------------------------------------------------------------------------shortestConflict :: [Diff a] -> [Diff a] -> ([Hunk a], [Diff a], [Diff a])+shortestConflict :: [Diff.Diff a] -> [Diff.Diff a] -> ([Hunk a], [Diff.Diff a], [Diff.Diff a]) shortestConflict l r =     let (hunk, rA, rB) = go l r     in (uncurry toHunk hunk, rA, rB)@@ -97,8 +93,8 @@     go [] b = (([], b), [], [])     go a [] = ((a, []), [], [])     go a b =-      let (as, ta) = break isBoth a-          (bs, tb) = break isBoth b+      let (as, ta) = break isB a+          (bs, tb) = break isB b           am = sum $ map motion as           bm = sum $ map motion bs           (as', ta') = incurMotion bm ta@@ -107,19 +103,16 @@          then ((as, bs), ta, tb)          else ((as ++ as', bs ++ bs'), [], []) <> go ta' tb' -    isBoth (Both _ _) = True-    isBoth _ = False--    motion (Second _) = 0+    motion (Diff.Second _) = 0     motion _ = 1   ---------------------------------------------------------------------------------incurMotion :: Int -> [Diff a] -> ([Diff a], [Diff a])+incurMotion :: Int -> [Diff.Diff t] -> ([Diff.Diff t], [Diff.Diff t]) incurMotion _ [] = ([], []) incurMotion 0 as  = ([], as)-incurMotion n (a@(Both _ _):as) = ([a], []) <> incurMotion (pred n) as-incurMotion n (a@(Second _):as) = ([a], []) <> incurMotion (pred n) as+incurMotion n (a@(Diff.Both _ _):as) = ([a], []) <> incurMotion (pred n) as+incurMotion n (a@(Diff.Second _):as) = ([a], []) <> incurMotion (pred n) as incurMotion n (a:as) = ([a], []) <> incurMotion n as  

@@ -23,7 +23,7 @@  main :: IO () main =-  let testOpts = mempty { topt_maximum_generated_tests = Just 5000 }+  let testOpts = mempty { topt_maximum_generated_tests = Just 1000 }       runner = mempty { ropt_test_options = Just testOpts }   in defaultMainWithOpts        [ testProperty "Can make changes in left document" leftChanges