diff --git a/Data/Git/Diff.hs b/Data/Git/Diff.hs
index ad81d8e1b88c2fdccff92f6e5218dc1de32a6709..289922a3b06d13e00fad646d82bd6bed6997b74e 100644
--- a/Data/Git/Diff.hs
+++ b/Data/Git/Diff.hs
@@ -36,7 +36,8 @@ import Data.Git.Storage.Object
import Data.ByteString.Lazy.Char8 as L
import Data.Typeable
-import Data.Algorithm.Patience as AP (Item(..), diff)
+import Data.Git.Diff.Patience (Item(..), diff)
+
-- | represents a blob's content (i.e., the content of a file at a given
-- reference).
@@ -257,22 +258,21 @@ diffGetContext context list =
let (_, _, filteredDiff) = Prelude.foldr filterContext (0, AccuBottom, []) list
theList = removeTrailingBoth filteredDiff
in case Prelude.head theList of
- (NormalLine (Both l1 _)) -> if (lineNumber l1) > 1 then Separator:theList
- else theList
+ (NormalLine (Both l _)) -> if lineNumber l > 1 then Separator:theList else theList
_ -> theList
where -- only keep 'context'. The file is annalyzed from the bottom to the top.
-- The accumulator here is a tuple3 with (the line counter, the
-- direction and the list of elements)
filterContext :: (Item TextLine) -> (Int, GitAccu, [FilteredDiff]) -> (Int, GitAccu, [FilteredDiff])
- filterContext (Both l1 l2) (c, AccuBottom, acc) =
- if c < context then (c+1, AccuBottom, (NormalLine (Both l1 l2)):acc)
- else (c , AccuBottom, (NormalLine (Both l1 l2))
+ filterContext b@(Both {}) (c, AccuBottom, acc) =
+ if c < context then (c+1, AccuBottom, (NormalLine b):acc)
+ else (c , AccuBottom, (NormalLine b)
:((Prelude.take (context-1) acc)
++ [Separator]
++ (Prelude.drop (context+1) acc)))
- filterContext (Both l1 l2) (c, AccuTop, acc) =
- if c < context then (c+1, AccuTop , (NormalLine (Both l1 l2)):acc)
- else (0 , AccuBottom, (NormalLine (Both l1 l2)):acc)
+ filterContext b@(Both {}) (c, AccuTop, acc) =
+ if c < context then (c+1, AccuTop , (NormalLine b):acc)
+ else (0 , AccuBottom, (NormalLine b):acc)
filterContext element (_, _, acc) =
(0, AccuTop, (NormalLine element):acc)
@@ -281,8 +281,8 @@ diffGetContext context list =
startWithSeparator (Separator:_) = True
startWithSeparator ((NormalLine l):xs) =
case l of
- (Both _ _) -> startWithSeparator xs
- _ -> False
+ Both {} -> startWithSeparator xs
+ _ -> False
removeTrailingBoth :: [FilteredDiff] -> [FilteredDiff]
removeTrailingBoth diffList =
diff --git a/Data/Git/Diff/Patience.hs b/Data/Git/Diff/Patience.hs
new file mode 100644
index 0000000000000000000000000000000000000000..9aa329ae124636755cc41e870404779352f48e9c
--- /dev/null
+++ b/Data/Git/Diff/Patience.hs
@@ -0,0 +1,108 @@
+-- loosely based on the patience-0.1.1 package which is:
+--
+-- Copyright (c) Keegan McAllister 2011
+--
+module Data.Git.Diff.Patience
+ ( Item(..)
+ , diff
+ ) where
+
+import Data.List
+import Data.Function (on)
+import qualified Data.Map as M
+import qualified Data.IntMap as IM
+
+data Card a = Card !Int a !(Maybe (Card a))
+
+-- sort using patience making stack of card with the list of elements,
+-- then take the highest stack (maxView) and flatten the path back into a list
+-- to get the longest increasing path
+longestIncreasing :: [(Int,a)] -> [(Int,a)]
+longestIncreasing =
+ maybe [] (flatten . head . fst)
+ . IM.maxView
+ . foldl' ins IM.empty
+ where
+ ins :: IM.IntMap [Card a] -> (Int, a) -> IM.IntMap [Card a]
+ ins m (x,a) =
+ case IM.minViewWithKey gt of
+ Nothing -> IM.insert x [new] m
+ Just ((k,_),_) ->
+ case IM.updateLookupWithKey (\_ _ -> Nothing) k m of
+ (Just v, mm) -> IM.insert x (new : v) mm
+ (Nothing, _) -> m
+ where
+ (lt, gt) = IM.split x m
+ prev = (head . fst) `fmap` IM.maxView lt
+ new = Card x a prev
+
+ flatten :: Card a -> [(Int, a)]
+ flatten (Card x a c) = (x,a) : maybe [] flatten c
+
+-- Type for decomposing a diff problem. We either have two
+-- lines that match, or a recursive subproblem.
+data Piece a =
+ Match !a !a
+ | Diff [a] [a]
+ deriving (Show)
+
+-- Get the longest common subsequence
+lcs :: Ord t => [t] -> [t] -> [Piece t]
+lcs ma mb =
+ chop ma mb
+ $ longestIncreasing
+ $ sortBy (compare `on` snd)
+ $ M.elems
+ $ M.intersectionWith (,) (unique ma) (unique mb)
+ where
+ unique = M.mapMaybe id . foldr ins M.empty . zip [0..]
+ where
+ ins (a,x) = M.insertWith (\_ _ -> Nothing) x (Just a)
+
+ -- Subdivides a diff problem according to the indices of matching lines.
+ chop :: [t] -> [t] -> [(Int,Int)] -> [Piece t]
+ chop xs ys []
+ | null xs && null ys = []
+ | otherwise = [Diff xs ys]
+ chop xs ys ((nx,ny):ns) =
+ let (xsr, (x : xse)) = splitAt nx xs
+ (ysr, (y : yse)) = splitAt ny ys
+ in Diff xse yse : Match x y : chop xsr ysr ns
+
+-- | An element of a computed difference.
+data Item t =
+ Old !t
+ | New !t
+ | Both !t !t
+ deriving (Show,Eq)
+
+instance Functor Item where
+ fmap f (Old x) = Old (f x)
+ fmap f (New x) = New (f x)
+ fmap f (Both x y) = Both (f x) (f y)
+
+-- | The difference between two lists using the patience algorithm
+diff :: Ord t => [t] -> [t] -> [Item t]
+diff = matchPrefix []
+ where
+ -- match the prefix between old and new document
+ matchPrefix acc (x:xs) (y:ys)
+ | x == y = Both x y : matchPrefix acc xs ys
+ matchPrefix acc l r = matchSuffix acc (reverse l) (reverse r)
+
+ -- match the suffix between old and new document, accumulating the
+ -- matched item in a reverse accumulator to keep TCO
+ matchSuffix acc (x:xs) (y:ys)
+ | x == y = matchSuffix (Both x y : acc) xs ys
+ matchSuffix acc l r = diffInner (reverse acc) (reverse l) (reverse r)
+
+ -- prefix and suffix are striped, and now do the LCS
+ diffInner acc l r =
+ case lcs l r of
+ -- If we fail to subdivide, just record the chunk as is.
+ [Diff _ _] -> fmap Old l ++ fmap New r ++ acc
+ ps -> recur acc ps
+
+ recur acc [] = acc
+ recur acc (Match x y : ps) = recur (Both x y : acc) ps
+ recur acc (Diff xs ys : ps) = recur [] ps ++ matchPrefix acc xs ys
diff --git a/git.cabal b/git.cabal
index ab69667820c44c41c4741bae35ed4f30e7347d39..f0ee161a19f7a7cadae08d1e3025fe23e7bdebfd 100644
--- a/git.cabal
+++ b/git.cabal
@@ -40,7 +40,6 @@ Library
, hourglass >= 0.2
, unix-compat
, utf8-string
- , patience
-- to remove
, system-filepath
, system-fileio
@@ -58,6 +57,7 @@ Library
Data.Git.Revision
Data.Git.Repository
Data.Git.Diff
+ Data.Git.Diff.Patience
Other-modules: Data.Git.Internal
Data.Git.Imports
Data.Git.OS
diff --git a/stack.yaml b/stack.yaml
index 6fba68376537630ad4b0229f3fc0e5fe6bc0d78f..fd510af7413b420e8e4bcac0983c7110b785639a 100644
--- a/stack.yaml
+++ b/stack.yaml
@@ -1,5 +1,4 @@
-resolver: lts-12.7
+resolver: lts-12.21
packages:
- .
-extra-deps:
-- patience-0.1.1
+extra-deps: []