--  Copyright (C) 2002,2008-2009 David Roundy
--
--  This program is free software; you can redistribute it and/or modify
--  it under the terms of the GNU General Public License as published by
--  the Free Software Foundation; either version 2, or (at your option)
--  any later version.
--
--  This program is distributed in the hope that it will be useful,
--  but WITHOUT ANY WARRANTY; without even the implied warranty of
--  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
--  GNU General Public License for more details.
--
--  You should have received a copy of the GNU General Public License
--  along with this program; if not, write to the Free Software Foundation,
--  Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.

module Darcs.Util.Diff.Patience
    ( getChanges
    ) where

import Darcs.Prelude

import Data.List ( sort )
import Data.Array.Unboxed
import Data.Array.ST
import Control.Monad.ST
import qualified Data.Set as S
import qualified Data.ByteString as B ( ByteString, elem )
import qualified Data.ByteString.Char8 as BC ( pack )
import qualified Data.Map.Strict as M
    ( Map, lookup, insertWith, empty, elems )
import qualified Data.Hashable as H ( hash )
import Darcs.Util.Diff.Myers (initP, aLen, PArray, getSlice)

empty :: HunkMap
empty :: HunkMap
empty = Hunk -> HMap Hunk [(Hunk, ByteString)] -> HunkMap
HunkMapInfo Hunk
0 HMap Hunk [(Hunk, ByteString)]
forall k a. Map k a
M.empty

getChanges ::  [B.ByteString] -> [B.ByteString]
           -> [(Int,[B.ByteString],[B.ByteString])]
getChanges :: [ByteString]
-> [ByteString] -> [(Hunk, [ByteString], [ByteString])]
getChanges [ByteString]
a [ByteString]
b = PArray -> PArray -> Hunk -> [(Hunk, [ByteString], [ByteString])]
dropStart ([ByteString] -> PArray
initP [ByteString]
a) ([ByteString] -> PArray
initP [ByteString]
b) Hunk
1

dropStart ::  PArray -> PArray -> Int
           -> [(Int,[B.ByteString],[B.ByteString])]
dropStart :: PArray -> PArray -> Hunk -> [(Hunk, [ByteString], [ByteString])]
dropStart PArray
a PArray
b Hunk
off
  | Hunk
off Hunk -> Hunk -> Bool
forall a. Ord a => a -> a -> Bool
> PArray -> Hunk
forall (a :: * -> * -> *) e. IArray a e => a Hunk e -> Hunk
aLen PArray
a = [(Hunk
off Hunk -> Hunk -> Hunk
forall a. Num a => a -> a -> a
- Hunk
1, [], PArray -> Hunk -> Hunk -> [ByteString]
getSlice PArray
b Hunk
off (PArray -> Hunk
forall (a :: * -> * -> *) e. IArray a e => a Hunk e -> Hunk
aLen PArray
b))]
  | Hunk
off Hunk -> Hunk -> Bool
forall a. Ord a => a -> a -> Bool
> PArray -> Hunk
forall (a :: * -> * -> *) e. IArray a e => a Hunk e -> Hunk
aLen PArray
b = [(Hunk
off Hunk -> Hunk -> Hunk
forall a. Num a => a -> a -> a
- Hunk
1, PArray -> Hunk -> Hunk -> [ByteString]
getSlice PArray
a Hunk
off (PArray -> Hunk
forall (a :: * -> * -> *) e. IArray a e => a Hunk e -> Hunk
aLen PArray
a), [])]
  | PArray
aPArray -> Hunk -> ByteString
forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
a i e -> i -> e
!Hunk
off ByteString -> ByteString -> Bool
forall a. Eq a => a -> a -> Bool
== PArray
bPArray -> Hunk -> ByteString
forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
a i e -> i -> e
!Hunk
off = PArray -> PArray -> Hunk -> [(Hunk, [ByteString], [ByteString])]
dropStart PArray
a PArray
b (Hunk
off Hunk -> Hunk -> Hunk
forall a. Num a => a -> a -> a
+ Hunk
1)
  | Bool
otherwise      = PArray
-> PArray -> Hunk -> Hunk -> [(Hunk, [ByteString], [ByteString])]
dropEnd PArray
a PArray
b Hunk
off Hunk
0

dropEnd ::  PArray -> PArray -> Int -> Int
        -> [(Int,[B.ByteString],[B.ByteString])]
dropEnd :: PArray
-> PArray -> Hunk -> Hunk -> [(Hunk, [ByteString], [ByteString])]
dropEnd PArray
a PArray
b Hunk
off Hunk
end
    | Hunk
off Hunk -> Hunk -> Bool
forall a. Ord a => a -> a -> Bool
> Hunk
alast        = [(Hunk
off Hunk -> Hunk -> Hunk
forall a. Num a => a -> a -> a
- Hunk
1, [], PArray -> Hunk -> Hunk -> [ByteString]
getSlice PArray
b Hunk
off Hunk
blast)]
    | Hunk
off Hunk -> Hunk -> Bool
forall a. Ord a => a -> a -> Bool
> Hunk
blast        = [(Hunk
off Hunk -> Hunk -> Hunk
forall a. Num a => a -> a -> a
- Hunk
1, PArray -> Hunk -> Hunk -> [ByteString]
getSlice PArray
a Hunk
off Hunk
alast, [])]
    | PArray
aPArray -> Hunk -> ByteString
forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
a i e -> i -> e
!Hunk
alast ByteString -> ByteString -> Bool
forall a. Eq a => a -> a -> Bool
== PArray
bPArray -> Hunk -> ByteString
forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
a i e -> i -> e
!Hunk
blast = PArray
-> PArray -> Hunk -> Hunk -> [(Hunk, [ByteString], [ByteString])]
dropEnd PArray
a PArray
b Hunk
off (Hunk
end Hunk -> Hunk -> Hunk
forall a. Num a => a -> a -> a
+ Hunk
1)
    | Bool
otherwise          = Hunk
-> [ByteString]
-> [ByteString]
-> [(Hunk, [ByteString], [ByteString])]
getChanges' (Hunk
offHunk -> Hunk -> Hunk
forall a. Num a => a -> a -> a
-Hunk
1) (PArray -> Hunk -> Hunk -> [ByteString]
getSlice PArray
a Hunk
off (PArray -> Hunk
forall (a :: * -> * -> *) e. IArray a e => a Hunk e -> Hunk
aLen PArray
a Hunk -> Hunk -> Hunk
forall a. Num a => a -> a -> a
- Hunk
end')) (PArray -> Hunk -> Hunk -> [ByteString]
getSlice PArray
b Hunk
off (PArray -> Hunk
forall (a :: * -> * -> *) e. IArray a e => a Hunk e -> Hunk
aLen PArray
b Hunk -> Hunk -> Hunk
forall a. Num a => a -> a -> a
- Hunk
end'))
  where end' :: Hunk
end' = Hunk -> Hunk
addBorings Hunk
end -- don't drop Borings just in case. See hidden_conflict2.sh
        addBorings :: Hunk -> Hunk
addBorings Hunk
e | Hunk
e Hunk -> Hunk -> Bool
forall a. Ord a => a -> a -> Bool
> Hunk
0 Bool -> Bool -> Bool
&& PArray
aPArray -> Hunk -> ByteString
forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
a i e -> i -> e
!(PArray -> Hunk
forall (a :: * -> * -> *) e. IArray a e => a Hunk e -> Hunk
aLen PArray
a Hunk -> Hunk -> Hunk
forall a. Num a => a -> a -> a
- (Hunk
eHunk -> Hunk -> Hunk
forall a. Num a => a -> a -> a
-Hunk
1)) ByteString -> [ByteString] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [ByteString]
borings' = Hunk -> Hunk
addBorings (Hunk
eHunk -> Hunk -> Hunk
forall a. Num a => a -> a -> a
-Hunk
1)
                     | Bool
otherwise = Hunk
e
        alast :: Hunk
alast = PArray -> Hunk
forall (a :: * -> * -> *) e. IArray a e => a Hunk e -> Hunk
aLen PArray
a Hunk -> Hunk -> Hunk
forall a. Num a => a -> a -> a
- Hunk
end
        blast :: Hunk
blast = PArray -> Hunk
forall (a :: * -> * -> *) e. IArray a e => a Hunk e -> Hunk
aLen PArray
b Hunk -> Hunk -> Hunk
forall a. Num a => a -> a -> a
- Hunk
end

getChanges' :: Int -> [B.ByteString] -> [B.ByteString]
              -> [(Int, [B.ByteString], [B.ByteString])]
getChanges' :: Hunk
-> [ByteString]
-> [ByteString]
-> [(Hunk, [ByteString], [ByteString])]
getChanges' Hunk
off [ByteString]
o [ByteString]
n = [(Hunk, [ByteString], [ByteString])]
-> [(Hunk, [Hunk], [Hunk])] -> [(Hunk, [ByteString], [ByteString])]
forall {a}.
[(a, [ByteString], [ByteString])]
-> [(a, [Hunk], [Hunk])] -> [(a, [ByteString], [ByteString])]
convertLBS [] ([(Hunk, [Hunk], [Hunk])] -> [(Hunk, [ByteString], [ByteString])])
-> [(Hunk, [Hunk], [Hunk])] -> [(Hunk, [ByteString], [ByteString])]
forall a b. (a -> b) -> a -> b
$ [[Hunk] -> [[Hunk]]]
-> Hunk -> [Hunk] -> [Hunk] -> [(Hunk, [Hunk], [Hunk])]
genNestedChanges [[Hunk] -> [[Hunk]]
byparagraph, [Hunk] -> [[Hunk]]
bylines] Hunk
off [Hunk]
oh [Hunk]
nh
            where
              ([Hunk]
_,HunkMap
m') = [ByteString] -> HunkMap -> ([Hunk], HunkMap)
listToHunk [ByteString]
borings' HunkMap
empty
              ([Hunk]
oh,HunkMap
m) = [ByteString] -> HunkMap -> ([Hunk], HunkMap)
listToHunk [ByteString]
o HunkMap
m'
              ([Hunk]
nh,HunkMap
lmap) = [ByteString] -> HunkMap -> ([Hunk], HunkMap)
listToHunk [ByteString]
n HunkMap
m
              convertLBS :: [(a, [ByteString], [ByteString])]
-> [(a, [Hunk], [Hunk])] -> [(a, [ByteString], [ByteString])]
convertLBS [(a, [ByteString], [ByteString])]
ys [] = [(a, [ByteString], [ByteString])]
-> [(a, [ByteString], [ByteString])]
forall a. [a] -> [a]
reverse [(a, [ByteString], [ByteString])]
ys
              convertLBS [(a, [ByteString], [ByteString])]
ys ((a
i,[Hunk]
os,[Hunk]
ns):[(a, [Hunk], [Hunk])]
xs) = [(a, [ByteString], [ByteString])]
-> [(a, [Hunk], [Hunk])] -> [(a, [ByteString], [ByteString])]
convertLBS ((a
i, [Hunk] -> [ByteString]
hunkToBS [Hunk]
os, [Hunk] -> [ByteString]
hunkToBS [Hunk]
ns)(a, [ByteString], [ByteString])
-> [(a, [ByteString], [ByteString])]
-> [(a, [ByteString], [ByteString])]
forall a. a -> [a] -> [a]
:[(a, [ByteString], [ByteString])]
ys) [(a, [Hunk], [Hunk])]
xs
              hunkToBS :: [Hunk] -> [ByteString]
hunkToBS [Hunk]
hs = (Hunk -> ByteString) -> [Hunk] -> [ByteString]
forall a b. (a -> b) -> [a] -> [b]
map (\Hunk
h -> PArray -> Hunk -> ByteString
forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
a i e -> i -> e
(!) PArray
harray (Hunk -> Hunk
forall a. Num a => a -> a
abs Hunk
h)) [Hunk]
hs
              harray :: PArray
harray = HunkMap -> PArray
getBArray HunkMap
lmap

type HMap = M.Map
type Hash = Int
type Hunk = Int
data HunkMap = HunkMapInfo Int (HMap Hash [(Hunk, B.ByteString)])

getMap :: HunkMap -> HMap Hash [(Hunk, B.ByteString)]
getMap :: HunkMap -> HMap Hunk [(Hunk, ByteString)]
getMap (HunkMapInfo Hunk
_ HMap Hunk [(Hunk, ByteString)]
m) = HMap Hunk [(Hunk, ByteString)]
m

getSize :: HunkMap -> Int
getSize :: HunkMap -> Hunk
getSize (HunkMapInfo Hunk
s HMap Hunk [(Hunk, ByteString)]
_) = Hunk
s

getBArray :: HunkMap -> Array Hunk B.ByteString
getBArray :: HunkMap -> PArray
getBArray (HunkMapInfo Hunk
size HMap Hunk [(Hunk, ByteString)]
b) = (Hunk, Hunk) -> [(Hunk, ByteString)] -> PArray
forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
(i, i) -> [(i, e)] -> a i e
array (Hunk
1,Hunk
size) ([(Hunk, ByteString)] -> PArray) -> [(Hunk, ByteString)] -> PArray
forall a b. (a -> b) -> a -> b
$ ((Hunk, ByteString) -> (Hunk, ByteString))
-> [(Hunk, ByteString)] -> [(Hunk, ByteString)]
forall a b. (a -> b) -> [a] -> [b]
map (\(Hunk
x,ByteString
a) -> (Hunk -> Hunk
forall a. Num a => a -> a
abs Hunk
x, ByteString
a)) ([(Hunk, ByteString)] -> [(Hunk, ByteString)])
-> [(Hunk, ByteString)] -> [(Hunk, ByteString)]
forall a b. (a -> b) -> a -> b
$ [[(Hunk, ByteString)]] -> [(Hunk, ByteString)]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[(Hunk, ByteString)]] -> [(Hunk, ByteString)])
-> [[(Hunk, ByteString)]] -> [(Hunk, ByteString)]
forall a b. (a -> b) -> a -> b
$ HMap Hunk [(Hunk, ByteString)] -> [[(Hunk, ByteString)]]
forall k a. Map k a -> [a]
M.elems HMap Hunk [(Hunk, ByteString)]
b

insert :: Hash -> B.ByteString -> HunkMap -> (Hunk, HunkMap)
insert :: Hunk -> ByteString -> HunkMap -> (Hunk, HunkMap)
insert Hunk
h ByteString
bs HunkMap
hmap = (Hunk
hunknumber, Hunk -> HMap Hunk [(Hunk, ByteString)] -> HunkMap
HunkMapInfo Hunk
newsize (([(Hunk, ByteString)]
 -> [(Hunk, ByteString)] -> [(Hunk, ByteString)])
-> Hunk
-> [(Hunk, ByteString)]
-> HMap Hunk [(Hunk, ByteString)]
-> HMap Hunk [(Hunk, ByteString)]
forall k a. Ord k => (a -> a -> a) -> k -> a -> Map k a -> Map k a
M.insertWith (\[(Hunk, ByteString)]
_ [(Hunk, ByteString)]
o -> (Hunk
hunknumber,ByteString
bs)(Hunk, ByteString) -> [(Hunk, ByteString)] -> [(Hunk, ByteString)]
forall a. a -> [a] -> [a]
:[(Hunk, ByteString)]
o) Hunk
h [(Hunk
hunknumber,ByteString
bs)] (HMap Hunk [(Hunk, ByteString)] -> HMap Hunk [(Hunk, ByteString)])
-> HMap Hunk [(Hunk, ByteString)] -> HMap Hunk [(Hunk, ByteString)]
forall a b. (a -> b) -> a -> b
$ HunkMap -> HMap Hunk [(Hunk, ByteString)]
getMap HunkMap
hmap))
      where hunknumber :: Hunk
hunknumber = if Word8 -> ByteString -> Bool
B.elem Word8
nl ByteString
bs then -Hunk
newsize -- used by bylines
                                         else Hunk
newsize
            newsize :: Hunk
newsize = HunkMap -> Hunk
getSize HunkMap
hmapHunk -> Hunk -> Hunk
forall a. Num a => a -> a -> a
+Hunk
1
            nl :: Word8
nl = Word8
10 -- '\n'

--Given a HunkMap, check collisions and return the line with an updated Map
toHunk' :: HunkMap -> B.ByteString -> (Hunk, HunkMap)
toHunk' :: HunkMap -> ByteString -> (Hunk, HunkMap)
toHunk' HunkMap
lmap ByteString
bs =
  case Hunk
-> HMap Hunk [(Hunk, ByteString)] -> Maybe [(Hunk, ByteString)]
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup Hunk
hash (HunkMap -> HMap Hunk [(Hunk, ByteString)]
getMap HunkMap
lmap) of
    Maybe [(Hunk, ByteString)]
Nothing -> Hunk -> ByteString -> HunkMap -> (Hunk, HunkMap)
insert Hunk
hash ByteString
bs HunkMap
lmap
    Just [(Hunk, ByteString)]
hunkpairs ->
        case ((Hunk, ByteString) -> Bool)
-> [(Hunk, ByteString)] -> [(Hunk, ByteString)]
forall a. (a -> Bool) -> [a] -> [a]
filter ((ByteString -> ByteString -> Bool
forall a. Eq a => a -> a -> Bool
== ByteString
bs) (ByteString -> Bool)
-> ((Hunk, ByteString) -> ByteString) -> (Hunk, ByteString) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Hunk, ByteString) -> ByteString
forall a b. (a, b) -> b
snd) [(Hunk, ByteString)]
hunkpairs of
            [] -> Hunk -> ByteString -> HunkMap -> (Hunk, HunkMap)
insert Hunk
hash ByteString
bs HunkMap
lmap
            (Hunk
hunknumber, ByteString
_):[(Hunk, ByteString)]
_ -> (Hunk
hunknumber, HunkMap
lmap)
    where hash :: Hunk
hash = ByteString -> Hunk
forall a. Hashable a => a -> Hunk
H.hash ByteString
bs

listToHunk :: [B.ByteString] -> HunkMap -> ([Hunk], HunkMap)
listToHunk :: [ByteString] -> HunkMap -> ([Hunk], HunkMap)
listToHunk [] HunkMap
hmap = ([], HunkMap
hmap)
listToHunk (ByteString
x:[ByteString]
xs) HunkMap
hmap = let (Hunk
y, HunkMap
hmap') = HunkMap -> ByteString -> (Hunk, HunkMap)
toHunk' HunkMap
hmap ByteString
x
                             ([Hunk]
ys, HunkMap
hmap'') = [ByteString] -> HunkMap -> ([Hunk], HunkMap)
listToHunk [ByteString]
xs HunkMap
hmap'
                         in (Hunk
yHunk -> [Hunk] -> [Hunk]
forall a. a -> [a] -> [a]
:[Hunk]
ys, HunkMap
hmap'')

--listToHunk :: [B.ByteString] -> HunkMap -> ([Hunk], HunkMap)
--listToHunk = listToHunk' []
--      where listToHunk' xs [] hmap = (reverse xs, hmap)
--            listToHunk' xs (y:ys) hmap = let (h,hmap') = toHunk' hmap y
--                                         in listToHunk' (h:xs) ys hmap'


genNestedChanges :: [[Hunk] -> [[Hunk]]]
                 -> Int -> [Hunk] -> [Hunk]
                 -> [(Int, [Hunk], [Hunk])]
genNestedChanges :: [[Hunk] -> [[Hunk]]]
-> Hunk -> [Hunk] -> [Hunk] -> [(Hunk, [Hunk], [Hunk])]
genNestedChanges ([Hunk] -> [[Hunk]]
br:[[Hunk] -> [[Hunk]]]
brs) Hunk
i0 [Hunk]
o0 [Hunk]
n0 = Hunk
-> [[Hunk]] -> [[Hunk]] -> [[Hunk]] -> [(Hunk, [Hunk], [Hunk])]
nc Hunk
i0 ([[Hunk]] -> [[Hunk]] -> [[Hunk]]
forall a. Ord a => [a] -> [a] -> [a]
lcus [[Hunk]]
ol [[Hunk]]
nl) [[Hunk]]
ol [[Hunk]]
nl
    where nl :: [[Hunk]]
nl = [Hunk] -> [[Hunk]]
br [Hunk]
n0
          ol :: [[Hunk]]
ol = [Hunk] -> [[Hunk]]
br [Hunk]
o0
          nc :: Hunk
-> [[Hunk]] -> [[Hunk]] -> [[Hunk]] -> [(Hunk, [Hunk], [Hunk])]
nc Hunk
i [] [[Hunk]]
o [[Hunk]]
n = Hunk -> [[Hunk]] -> [[Hunk]] -> [(Hunk, [Hunk], [Hunk])]
forall {t :: * -> *} {t :: * -> *}.
(Foldable t, Foldable t) =>
Hunk -> t [Hunk] -> t [Hunk] -> [(Hunk, [Hunk], [Hunk])]
easydiff Hunk
i [[Hunk]]
o [[Hunk]]
n
          nc Hunk
i ([Hunk]
x:[[Hunk]]
xs) [[Hunk]]
o [[Hunk]]
n =
              case ([Hunk] -> Bool) -> [[Hunk]] -> ([[Hunk]], [[Hunk]])
forall a. (a -> Bool) -> [a] -> ([a], [a])
break ([Hunk] -> [Hunk] -> Bool
forall a. Eq a => a -> a -> Bool
==[Hunk]
x) [[Hunk]]
o of
                ([[Hunk]]
oa, [Hunk]
_:[[Hunk]]
ob) ->
                    case ([Hunk] -> Bool) -> [[Hunk]] -> ([[Hunk]], [[Hunk]])
forall a. (a -> Bool) -> [a] -> ([a], [a])
break ([Hunk] -> [Hunk] -> Bool
forall a. Eq a => a -> a -> Bool
==[Hunk]
x) [[Hunk]]
n of
                      ([[Hunk]]
na, [Hunk]
_:[[Hunk]]
nb) ->
                         Hunk
i' Hunk -> [(Hunk, [Hunk], [Hunk])] -> [(Hunk, [Hunk], [Hunk])]
forall a b. a -> b -> b
`seq` Hunk -> [[Hunk]] -> [[Hunk]] -> [(Hunk, [Hunk], [Hunk])]
forall {t :: * -> *} {t :: * -> *}.
(Foldable t, Foldable t) =>
Hunk -> t [Hunk] -> t [Hunk] -> [(Hunk, [Hunk], [Hunk])]
easydiff Hunk
i [[Hunk]]
oa [[Hunk]]
na [(Hunk, [Hunk], [Hunk])]
-> [(Hunk, [Hunk], [Hunk])] -> [(Hunk, [Hunk], [Hunk])]
forall a. [a] -> [a] -> [a]
++ Hunk
-> [[Hunk]] -> [[Hunk]] -> [[Hunk]] -> [(Hunk, [Hunk], [Hunk])]
nc Hunk
i' [[Hunk]]
xs [[Hunk]]
ob [[Hunk]]
nb
                             where i' :: Hunk
i' = Hunk
i Hunk -> Hunk -> Hunk
forall a. Num a => a -> a -> a
+ [Hunk] -> Hunk
forall a. [a] -> Hunk
forall (t :: * -> *) a. Foldable t => t a -> Hunk
length ([[Hunk]] -> [Hunk]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[Hunk]]
na) Hunk -> Hunk -> Hunk
forall a. Num a => a -> a -> a
+ [Hunk] -> Hunk
forall a. [a] -> Hunk
forall (t :: * -> *) a. Foldable t => t a -> Hunk
length [Hunk]
x
                      ([[Hunk]]
_,[]) -> [Char] -> [(Hunk, [Hunk], [Hunk])]
forall a. HasCallStack => [Char] -> a
error [Char]
"impossible case"
                ([[Hunk]]
_,[]) -> [Char] -> [(Hunk, [Hunk], [Hunk])]
forall a. HasCallStack => [Char] -> a
error [Char]
"impossible case"
          easydiff :: Hunk -> t [Hunk] -> t [Hunk] -> [(Hunk, [Hunk], [Hunk])]
easydiff Hunk
i t [Hunk]
o t [Hunk]
n = [[Hunk] -> [[Hunk]]]
-> Hunk -> [Hunk] -> [Hunk] -> [(Hunk, [Hunk], [Hunk])]
genNestedChanges [[Hunk] -> [[Hunk]]]
brs Hunk
i [Hunk]
oo [Hunk]
nn
              where ([Hunk]
oo, [Hunk]
nn) = (t [Hunk] -> [Hunk]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat t [Hunk]
o, t [Hunk] -> [Hunk]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat t [Hunk]
n)
genNestedChanges [] Hunk
i [Hunk]
o [Hunk]
n = ([Hunk] -> Bool)
-> Hunk -> [Hunk] -> [Hunk] -> [Hunk] -> [(Hunk, [Hunk], [Hunk])]
forall a.
Ord a =>
([a] -> Bool) -> Hunk -> [a] -> [a] -> [a] -> [(Hunk, [a], [a])]
mkdiff ((Hunk -> Bool) -> [Hunk] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (Hunk -> [Hunk] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Hunk]
borings)) Hunk
i [Hunk]
mylcs [Hunk]
o [Hunk]
n
        where mylcs :: [Hunk]
mylcs = [Hunk] -> [Hunk] -> [Hunk]
forall a. Ord a => [a] -> [a] -> [a]
patientLcs ((Hunk -> Bool) -> [Hunk] -> [Hunk]
forall a. (a -> Bool) -> [a] -> [a]
filter (Hunk -> [Hunk] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` [Hunk]
borings) [Hunk]
o)
                                 ((Hunk -> Bool) -> [Hunk] -> [Hunk]
forall a. (a -> Bool) -> [a] -> [a]
filter (Hunk -> [Hunk] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` [Hunk]
borings) [Hunk]
n)

borings :: [Hunk]
borings :: [Hunk]
borings = ([Hunk], HunkMap) -> [Hunk]
forall a b. (a, b) -> a
fst (([Hunk], HunkMap) -> [Hunk]) -> ([Hunk], HunkMap) -> [Hunk]
forall a b. (a -> b) -> a -> b
$ [ByteString] -> HunkMap -> ([Hunk], HunkMap)
listToHunk [ByteString]
borings' HunkMap
empty

borings' :: [B.ByteString]
borings' :: [ByteString]
borings' = ([Char] -> ByteString) -> [[Char]] -> [ByteString]
forall a b. (a -> b) -> [a] -> [b]
map [Char] -> ByteString
BC.pack [[Char]
"", [Char]
"\n", [Char]
" ", [Char]
")", [Char]
"(", [Char]
","]

byparagraph :: [Hunk] -> [[Hunk]]
byparagraph :: [Hunk] -> [[Hunk]]
byparagraph = [[Hunk]] -> [[Hunk]]
forall a. [a] -> [a]
reverse ([[Hunk]] -> [[Hunk]])
-> ([Hunk] -> [[Hunk]]) -> [Hunk] -> [[Hunk]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([Hunk] -> [Hunk]) -> [[Hunk]] -> [[Hunk]]
forall a b. (a -> b) -> [a] -> [b]
map [Hunk] -> [Hunk]
forall a. [a] -> [a]
reverse ([[Hunk]] -> [[Hunk]])
-> ([Hunk] -> [[Hunk]]) -> [Hunk] -> [[Hunk]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [[Hunk]] -> [Hunk] -> [[Hunk]]
byparagraphAcc []
    where byparagraphAcc :: [[Hunk]] -> [Hunk] -> [[Hunk]]
byparagraphAcc [[Hunk]]
xs [] = [[Hunk]]
xs
          byparagraphAcc [] (Hunk
a:Hunk
b:Hunk
c:[Hunk]
d)
              | Hunk
a Hunk -> Hunk -> Bool
forall a. Eq a => a -> a -> Bool
== Hunk
nl Bool -> Bool -> Bool
&& Hunk
c Hunk -> Hunk -> Bool
forall a. Eq a => a -> a -> Bool
== Hunk
nl Bool -> Bool -> Bool
&& Hunk
b Hunk -> Hunk -> Bool
forall a. Eq a => a -> a -> Bool
== Hunk
hnull = case [Hunk]
d of
                                                   [] -> [[Hunk
c,Hunk
b,Hunk
a]]
                                                   [Hunk]
_  -> [[Hunk]] -> [Hunk] -> [[Hunk]]
byparagraphAcc [[],[Hunk
c,Hunk
b,Hunk
a]] [Hunk]
d
          byparagraphAcc [] (Hunk
a:[Hunk]
as) = [[Hunk]] -> [Hunk] -> [[Hunk]]
byparagraphAcc [[Hunk
a]] [Hunk]
as
          byparagraphAcc ([Hunk]
x:[[Hunk]]
xs) (Hunk
a:Hunk
b:Hunk
c:[Hunk]
d)
              | Hunk
a Hunk -> Hunk -> Bool
forall a. Eq a => a -> a -> Bool
== Hunk
nl Bool -> Bool -> Bool
&& Hunk
c Hunk -> Hunk -> Bool
forall a. Eq a => a -> a -> Bool
== Hunk
nl Bool -> Bool -> Bool
&& Hunk
b Hunk -> Hunk -> Bool
forall a. Eq a => a -> a -> Bool
== Hunk
hnull = case [Hunk]
d of
                                                   [] -> (Hunk
cHunk -> [Hunk] -> [Hunk]
forall a. a -> [a] -> [a]
:Hunk
bHunk -> [Hunk] -> [Hunk]
forall a. a -> [a] -> [a]
:Hunk
aHunk -> [Hunk] -> [Hunk]
forall a. a -> [a] -> [a]
:[Hunk]
x)[Hunk] -> [[Hunk]] -> [[Hunk]]
forall a. a -> [a] -> [a]
:[[Hunk]]
xs
                                                   [Hunk]
_  -> [[Hunk]] -> [Hunk] -> [[Hunk]]
byparagraphAcc ([][Hunk] -> [[Hunk]] -> [[Hunk]]
forall a. a -> [a] -> [a]
:((Hunk
cHunk -> [Hunk] -> [Hunk]
forall a. a -> [a] -> [a]
:Hunk
bHunk -> [Hunk] -> [Hunk]
forall a. a -> [a] -> [a]
:Hunk
aHunk -> [Hunk] -> [Hunk]
forall a. a -> [a] -> [a]
:[Hunk]
x)[Hunk] -> [[Hunk]] -> [[Hunk]]
forall a. a -> [a] -> [a]
:[[Hunk]]
xs)) [Hunk]
d
          byparagraphAcc ([Hunk]
x:[[Hunk]]
xs) (Hunk
a:[Hunk]
as) = [[Hunk]] -> [Hunk] -> [[Hunk]]
byparagraphAcc ((Hunk
aHunk -> [Hunk] -> [Hunk]
forall a. a -> [a] -> [a]
:[Hunk]
x)[Hunk] -> [[Hunk]] -> [[Hunk]]
forall a. a -> [a] -> [a]
:[[Hunk]]
xs) [Hunk]
as
          nl :: Hunk
nl = -Hunk
1 -- "\n" hunk
          hnull :: Hunk
hnull = Hunk
1 -- "" hunk toHunk $ BC.pack ""

bylines :: [Hunk] -> [[Hunk]]
bylines :: [Hunk] -> [[Hunk]]
bylines = [[Hunk]] -> [[Hunk]]
forall a. [a] -> [a]
reverse ([[Hunk]] -> [[Hunk]])
-> ([Hunk] -> [[Hunk]]) -> [Hunk] -> [[Hunk]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [[Hunk]] -> [Hunk] -> [[Hunk]]
forall {a}. (Ord a, Num a) => [[a]] -> [a] -> [[a]]
bylinesAcc []
  where bylinesAcc :: [[a]] -> [a] -> [[a]]
bylinesAcc ![[a]]
ys [] = [[a]]
ys
        bylinesAcc ![[a]]
ys [a]
xs = case (a -> Bool) -> [a] -> ([a], [a])
forall a. (a -> Bool) -> [a] -> ([a], [a])
break (a -> a -> Bool
forall a. Ord a => a -> a -> Bool
<a
0) [a]
xs of
                              ([a]
_,[]) -> [a]
xs[a] -> [[a]] -> [[a]]
forall a. a -> [a] -> [a]
:[[a]]
ys
                              ([a]
a,a
n:[a]
b) -> [[a]] -> [a] -> [[a]]
bylinesAcc (([a]
a[a] -> [a] -> [a]
forall a. [a] -> [a] -> [a]
++[a
n])[a] -> [[a]] -> [[a]]
forall a. a -> [a] -> [a]
:[[a]]
ys) [a]
b


-- | the longest common subsequence of unique items

lcus :: Ord a => [a] -> [a] -> [a]
lcus :: forall a. Ord a => [a] -> [a] -> [a]
lcus [a]
xs0 [a]
ys0 = [a] -> [a] -> [a]
forall a. Ord a => [a] -> [a] -> [a]
lcs ((a -> Bool) -> [a] -> [a]
forall a. (a -> Bool) -> [a] -> [a]
filter (a -> Set a -> Bool
forall a. Ord a => a -> Set a -> Bool
`S.member`Set a
u) [a]
xs0) ((a -> Bool) -> [a] -> [a]
forall a. (a -> Bool) -> [a] -> [a]
filter (a -> Set a -> Bool
forall a. Ord a => a -> Set a -> Bool
`S.member`Set a
u) [a]
ys0)
    where uxs :: Set a
uxs = [a] -> Set a
forall {a}. Ord a => [a] -> Set a
findUnique [a]
xs0
          uys :: Set a
uys = [a] -> Set a
forall {a}. Ord a => [a] -> Set a
findUnique [a]
ys0
          u :: Set a
u = Set a -> Set a -> Set a
forall a. Ord a => Set a -> Set a -> Set a
S.intersection Set a
uxs Set a
uys
          findUnique :: [a] -> Set a
findUnique [a]
xs = [a] -> Set a
forall {a}. Ord a => [a] -> Set a
S.fromList ([a] -> Set a) -> [a] -> Set a
forall a b. (a -> b) -> a -> b
$ [a] -> [a]
forall {a}. Eq a => [a] -> [a]
gru ([a] -> [a]) -> [a] -> [a]
forall a b. (a -> b) -> a -> b
$ [a] -> [a]
forall a. Ord a => [a] -> [a]
sort [a]
xs
          gru :: [a] -> [a]
gru (a
x:a
x':[a]
xs) | a
x a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
x' = [a] -> [a]
gru ((a -> Bool) -> [a] -> [a]
forall a. (a -> Bool) -> [a] -> [a]
dropWhile (a -> a -> Bool
forall a. Eq a => a -> a -> Bool
==a
x) [a]
xs)
          gru (a
x:[a]
xs) = a
x a -> [a] -> [a]
forall a. a -> [a] -> [a]
: [a] -> [a]
gru [a]
xs
          gru [] = []


mkdiff :: Ord a =>
          ([a] -> Bool) -> Int -> [a] -> [a] -> [a] -> [(Int,[a],[a])]
mkdiff :: forall a.
Ord a =>
([a] -> Bool) -> Hunk -> [a] -> [a] -> [a] -> [(Hunk, [a], [a])]
mkdiff [a] -> Bool
b Hunk
ny (a
l:[a]
ls) (a
x:[a]
xs) (a
y:[a]
ys)
    | a
l a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
x Bool -> Bool -> Bool
&& a
l a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
y = ([a] -> Bool) -> Hunk -> [a] -> [a] -> [a] -> [(Hunk, [a], [a])]
forall a.
Ord a =>
([a] -> Bool) -> Hunk -> [a] -> [a] -> [a] -> [(Hunk, [a], [a])]
mkdiff [a] -> Bool
b (Hunk
nyHunk -> Hunk -> Hunk
forall a. Num a => a -> a -> a
+Hunk
1) [a]
ls [a]
xs [a]
ys
mkdiff [a] -> Bool
boring Hunk
ny (a
l:[a]
ls) [a]
xs [a]
ys
  | [a]
rmd [a] -> [a] -> Bool
forall a. Eq a => a -> a -> Bool
== [a]
add = ([a] -> Bool) -> Hunk -> [a] -> [a] -> [a] -> [(Hunk, [a], [a])]
forall a.
Ord a =>
([a] -> Bool) -> Hunk -> [a] -> [a] -> [a] -> [(Hunk, [a], [a])]
mkdiff [a] -> Bool
boring (Hunk
nyHunk -> Hunk -> Hunk
forall a. Num a => a -> a -> a
+[a] -> Hunk
forall a. [a] -> Hunk
forall (t :: * -> *) a. Foldable t => t a -> Hunk
length [a]
addHunk -> Hunk -> Hunk
forall a. Num a => a -> a -> a
+Hunk
1) [a]
ls [a]
restx [a]
resty
  | [a] -> Bool
boring [a]
rmd Bool -> Bool -> Bool
&& [a] -> Bool
boring [a]
add =
      case [a] -> [a] -> [a]
forall a. Ord a => [a] -> [a] -> [a]
lcs [a]
rmd [a]
add of
        [] -> Hunk -> [a] -> [a] -> [(Hunk, [a], [a])]
forall a. Ord a => Hunk -> [a] -> [a] -> [(Hunk, [a], [a])]
prefixPostfixDiff Hunk
ny [a]
rmd [a]
add [(Hunk, [a], [a])] -> [(Hunk, [a], [a])] -> [(Hunk, [a], [a])]
forall a. [a] -> [a] -> [a]
++
              ([a] -> Bool) -> Hunk -> [a] -> [a] -> [a] -> [(Hunk, [a], [a])]
forall a.
Ord a =>
([a] -> Bool) -> Hunk -> [a] -> [a] -> [a] -> [(Hunk, [a], [a])]
mkdiff [a] -> Bool
boring (Hunk
nyHunk -> Hunk -> Hunk
forall a. Num a => a -> a -> a
+[a] -> Hunk
forall a. [a] -> Hunk
forall (t :: * -> *) a. Foldable t => t a -> Hunk
length [a]
addHunk -> Hunk -> Hunk
forall a. Num a => a -> a -> a
+Hunk
1) [a]
ls [a]
restx [a]
resty
        [a]
ll -> ([a] -> Bool) -> Hunk -> [a] -> [a] -> [a] -> [(Hunk, [a], [a])]
forall a.
Ord a =>
([a] -> Bool) -> Hunk -> [a] -> [a] -> [a] -> [(Hunk, [a], [a])]
mkdiff (Bool -> [a] -> Bool
forall a b. a -> b -> a
const Bool
False) Hunk
ny [a]
ll [a]
rmd [a]
add [(Hunk, [a], [a])] -> [(Hunk, [a], [a])] -> [(Hunk, [a], [a])]
forall a. [a] -> [a] -> [a]
++
              ([a] -> Bool) -> Hunk -> [a] -> [a] -> [a] -> [(Hunk, [a], [a])]
forall a.
Ord a =>
([a] -> Bool) -> Hunk -> [a] -> [a] -> [a] -> [(Hunk, [a], [a])]
mkdiff [a] -> Bool
boring  (Hunk
nyHunk -> Hunk -> Hunk
forall a. Num a => a -> a -> a
+[a] -> Hunk
forall a. [a] -> Hunk
forall (t :: * -> *) a. Foldable t => t a -> Hunk
length [a]
addHunk -> Hunk -> Hunk
forall a. Num a => a -> a -> a
+Hunk
1) [a]
ls [a]
restx [a]
resty
  | Bool
otherwise = Hunk -> [a] -> [a] -> [(Hunk, [a], [a])]
forall a. Ord a => Hunk -> [a] -> [a] -> [(Hunk, [a], [a])]
prefixPostfixDiff Hunk
ny [a]
rmd [a]
add [(Hunk, [a], [a])] -> [(Hunk, [a], [a])] -> [(Hunk, [a], [a])]
forall a. [a] -> [a] -> [a]
++
                ([a] -> Bool) -> Hunk -> [a] -> [a] -> [a] -> [(Hunk, [a], [a])]
forall a.
Ord a =>
([a] -> Bool) -> Hunk -> [a] -> [a] -> [a] -> [(Hunk, [a], [a])]
mkdiff [a] -> Bool
boring (Hunk
nyHunk -> Hunk -> Hunk
forall a. Num a => a -> a -> a
+[a] -> Hunk
forall a. [a] -> Hunk
forall (t :: * -> *) a. Foldable t => t a -> Hunk
length [a]
addHunk -> Hunk -> Hunk
forall a. Num a => a -> a -> a
+Hunk
1) [a]
ls [a]
restx [a]
resty
    where rmd :: [a]
rmd = (a -> Bool) -> [a] -> [a]
forall a. (a -> Bool) -> [a] -> [a]
takeWhile (a -> a -> Bool
forall a. Eq a => a -> a -> Bool
/= a
l) [a]
xs
          add :: [a]
add = (a -> Bool) -> [a] -> [a]
forall a. (a -> Bool) -> [a] -> [a]
takeWhile (a -> a -> Bool
forall a. Eq a => a -> a -> Bool
/= a
l) [a]
ys
          restx :: [a]
restx = Hunk -> [a] -> [a]
forall a. Hunk -> [a] -> [a]
drop ([a] -> Hunk
forall a. [a] -> Hunk
forall (t :: * -> *) a. Foldable t => t a -> Hunk
length [a]
rmd Hunk -> Hunk -> Hunk
forall a. Num a => a -> a -> a
+ Hunk
1) [a]
xs
          resty :: [a]
resty = Hunk -> [a] -> [a]
forall a. Hunk -> [a] -> [a]
drop ([a] -> Hunk
forall a. [a] -> Hunk
forall (t :: * -> *) a. Foldable t => t a -> Hunk
length [a]
add Hunk -> Hunk -> Hunk
forall a. Num a => a -> a -> a
+ Hunk
1) [a]
ys
mkdiff [a] -> Bool
_ Hunk
_ [] [] [] = []
mkdiff [a] -> Bool
boring Hunk
ny [] [a]
rmd [a]
add
  | [a] -> Bool
boring [a]
rmd Bool -> Bool -> Bool
&& [a] -> Bool
boring [a]
add =
      case [a] -> [a] -> [a]
forall a. Ord a => [a] -> [a] -> [a]
lcs [a]
rmd [a]
add of
        [] -> Hunk -> [a] -> [a] -> [(Hunk, [a], [a])]
forall a. Ord a => Hunk -> [a] -> [a] -> [(Hunk, [a], [a])]
prefixPostfixDiff Hunk
ny [a]
rmd [a]
add
        [a]
ll -> ([a] -> Bool) -> Hunk -> [a] -> [a] -> [a] -> [(Hunk, [a], [a])]
forall a.
Ord a =>
([a] -> Bool) -> Hunk -> [a] -> [a] -> [a] -> [(Hunk, [a], [a])]
mkdiff (Bool -> [a] -> Bool
forall a b. a -> b -> a
const Bool
False) Hunk
ny [a]
ll [a]
rmd [a]
add
  | Bool
otherwise = Hunk -> [a] -> [a] -> [(Hunk, [a], [a])]
forall a. Ord a => Hunk -> [a] -> [a] -> [(Hunk, [a], [a])]
prefixPostfixDiff Hunk
ny [a]
rmd [a]
add

prefixPostfixDiff :: Ord a => Int -> [a] -> [a] -> [(Int,[a],[a])]
prefixPostfixDiff :: forall a. Ord a => Hunk -> [a] -> [a] -> [(Hunk, [a], [a])]
prefixPostfixDiff Hunk
_ [] [] = []
prefixPostfixDiff Hunk
ny [] [a]
ys = [(Hunk
ny,[],[a]
ys)]
prefixPostfixDiff Hunk
ny [a]
xs [] = [(Hunk
ny,[a]
xs,[])]
prefixPostfixDiff Hunk
ny (a
x:[a]
xs) (a
y:[a]
ys)
    | a
x a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
y = Hunk -> [a] -> [a] -> [(Hunk, [a], [a])]
forall a. Ord a => Hunk -> [a] -> [a] -> [(Hunk, [a], [a])]
prefixPostfixDiff (Hunk
nyHunk -> Hunk -> Hunk
forall a. Num a => a -> a -> a
+Hunk
1) [a]
xs [a]
ys
    | Bool
otherwise = [(Hunk
ny, [a] -> [a]
forall a. [a] -> [a]
reverse [a]
rxs', [a] -> [a]
forall a. [a] -> [a]
reverse [a]
rys')]
    where ([a]
rxs',[a]
rys') = [a] -> [a] -> ([a], [a])
forall {a}. Eq a => [a] -> [a] -> ([a], [a])
dropPref ([a] -> [a]
forall a. [a] -> [a]
reverse (a
xa -> [a] -> [a]
forall a. a -> [a] -> [a]
:[a]
xs)) ([a] -> [a]
forall a. [a] -> [a]
reverse (a
ya -> [a] -> [a]
forall a. a -> [a] -> [a]
:[a]
ys))
          dropPref :: [a] -> [a] -> ([a], [a])
dropPref (a
a:[a]
as) (a
b:[a]
bs) | a
a a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
b = [a] -> [a] -> ([a], [a])
dropPref [a]
as [a]
bs
          dropPref [a]
as [a]
bs = ([a]
as,[a]
bs)

-- | The patientLcs algorithm is inspired by the "patience" algorithm
-- (for which I don't have a reference handy), in that it looks for
-- unique lines, and uses them to subdivide the problem.  I use lcs to
-- diff the unique lines.  It is slower, but should lead to "better"
-- diffs, in the sense of ones that better align with what humans
-- think changed.
-- 
-- Note that when compared with the Meyers algorithm used in darcs,
-- this is somewhat slower (maybe 4x in some of my tests), but is
-- lacking its stack overflow problem.  I'm not sure how it scales in
-- general, but it scales fine (just 10x slower than GNU diff) when
-- comparing a 6M american english dictionary with a british english
-- dictionary of the same size (which isn't a great test, but is the
-- largest pair of somewhat-differing files I could find).
-- 
-- Note that the patientLcs algorithm is slower than the one used in
-- lcs for sequences with mostly unique elements (as is common in text
-- files), but much *faster* when the sequence has a high degree of
-- redundancy.  i.e. lines /usr/share/dict/words vs lines (cat
-- /usr/share/dict/words | tr 'a-z' 'a')

{-# SPECIALIZE patientLcs ::[Hunk] -> [Hunk] -> [Hunk] #-}
patientLcs :: Ord a => [a] -> [a] -> [a]
patientLcs :: forall a. Ord a => [a] -> [a] -> [a]
patientLcs [] [a]
_ = []
patientLcs [a]
_ [] = []
patientLcs (a
c1:[a]
c1s) (a
c2:[a]
c2s)
    | a
c1 a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
c2 = a
c1a -> [a] -> [a]
forall a. a -> [a] -> [a]
: [a] -> [a] -> [a]
forall a. Ord a => [a] -> [a] -> [a]
patientLcs [a]
c1s [a]
c2s
    | Bool
otherwise =
        [a] -> [a]
forall a. [a] -> [a]
reverse ([a] -> [a]) -> [a] -> [a]
forall a b. (a -> b) -> a -> b
$ [a] -> [a] -> [a]
forall a. Ord a => [a] -> [a] -> [a]
patientLcs0 ([a] -> [a]
forall a. [a] -> [a]
reverse (a
c1a -> [a] -> [a]
forall a. a -> [a] -> [a]
:[a]
c1s)) ([a] -> [a]
forall a. [a] -> [a]
reverse (a
c2a -> [a] -> [a]
forall a. a -> [a] -> [a]
:[a]
c2s))

patientLcs0 :: Ord a => [a] -> [a] -> [a]
patientLcs0 :: forall a. Ord a => [a] -> [a] -> [a]
patientLcs0 xs0 :: [a]
xs0@(a
cc1:[a]
cc1s) ys0 :: [a]
ys0@(a
cc2:[a]
cc2s)
    | a
cc1 a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
cc2 = a
cc1 a -> [a] -> [a]
forall a. a -> [a] -> [a]
: [a] -> [a] -> [a]
forall a. Ord a => [a] -> [a] -> [a]
patientLcs0 [a]
cc1s [a]
cc2s
    | Bool
otherwise = case ((a -> Bool) -> [a] -> [a]
forall a. (a -> Bool) -> [a] -> [a]
filter (a -> Set a -> Bool
forall a. Ord a => a -> Set a -> Bool
`S.member`Set a
uys) [a]
xs0, (a -> Bool) -> [a] -> [a]
forall a. (a -> Bool) -> [a] -> [a]
filter (a -> Set a -> Bool
forall a. Ord a => a -> Set a -> Bool
`S.member`Set a
uxs) [a]
ys0) of
                    ([],[a]
_) -> [a] -> [a] -> [a]
forall a. Ord a => [a] -> [a] -> [a]
lcs [a]
xs0 [a]
ys0
                    ([a]
_,[]) -> [a] -> [a] -> [a]
forall a. Ord a => [a] -> [a] -> [a]
lcs [a]
xs0 [a]
ys0
                    ([a]
xs',[a]
ys') -> [a] -> [a] -> [a] -> [a]
forall {a}. Ord a => [a] -> [a] -> [a] -> [a]
joinU ([a] -> [a] -> [a]
forall a. Ord a => [a] -> [a] -> [a]
lcs [a]
xs' [a]
ys') [a]
xs0 [a]
ys0
    where uxs :: Set a
uxs = [a] -> Set a
forall {a}. Ord a => [a] -> Set a
findUnique [a]
xs0
          uys :: Set a
uys = [a] -> Set a
forall {a}. Ord a => [a] -> Set a
findUnique [a]
ys0
          joinU :: [a] -> [a] -> [a] -> [a]
joinU [] [a]
x [a]
y = [a] -> [a] -> [a]
forall a. Ord a => [a] -> [a] -> [a]
lcs [a]
x [a]
y
          joinU (a
b:[a]
bs) [a]
cs [a]
ds =
                 case (a -> Bool) -> [a] -> ([a], [a])
forall a. (a -> Bool) -> [a] -> ([a], [a])
break (a -> a -> Bool
forall a. Eq a => a -> a -> Bool
==a
b) [a]
cs of
                   ([],a
_:[a]
c2) -> a
b a -> [a] -> [a]
forall a. a -> [a] -> [a]
: [a] -> [a] -> [a] -> [a]
joinU [a]
bs [a]
c2 (Hunk -> [a] -> [a]
forall a. Hunk -> [a] -> [a]
drop Hunk
1 ([a] -> [a]) -> [a] -> [a]
forall a b. (a -> b) -> a -> b
$ (a -> Bool) -> [a] -> [a]
forall a. (a -> Bool) -> [a] -> [a]
dropWhile (a -> a -> Bool
forall a. Eq a => a -> a -> Bool
/= a
b) [a]
ds)
                   ([a]
c1,a
_:[a]
c2) -> case (a -> Bool) -> [a] -> ([a], [a])
forall a. (a -> Bool) -> [a] -> ([a], [a])
break (a -> a -> Bool
forall a. Eq a => a -> a -> Bool
==a
b) [a]
ds of
                                  ([],a
_:[a]
d2) -> a
b a -> [a] -> [a]
forall a. a -> [a] -> [a]
: [a] -> [a] -> [a] -> [a]
joinU [a]
bs [a]
c2 [a]
d2
                                  ([a]
d1,a
_:[a]
d2) -> [a] -> [a] -> [a]
forall a. Ord a => [a] -> [a] -> [a]
lcs [a]
c1 [a]
d1 [a] -> [a] -> [a]
forall a. [a] -> [a] -> [a]
++ a
b a -> [a] -> [a]
forall a. a -> [a] -> [a]
: [a] -> [a] -> [a] -> [a]
joinU [a]
bs [a]
c2 [a]
d2
                                  ([a], [a])
_ -> [Char] -> [a]
forall a. HasCallStack => [Char] -> a
error [Char]
"impossible case"
                   ([a], [a])
_ -> [Char] -> [a]
forall a. HasCallStack => [Char] -> a
error [Char]
"impossible case"
          findUnique :: [a] -> Set a
findUnique [a]
xs = [a] -> Set a
forall {a}. Ord a => [a] -> Set a
S.fromList ([a] -> Set a) -> [a] -> Set a
forall a b. (a -> b) -> a -> b
$ [a] -> [a]
forall {a}. Eq a => [a] -> [a]
gru ([a] -> [a]) -> [a] -> [a]
forall a b. (a -> b) -> a -> b
$ [a] -> [a]
forall a. Ord a => [a] -> [a]
sort [a]
xs
          gru :: [a] -> [a]
gru (a
x:a
x':[a]
xs) | a
x a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
x' = [a] -> [a]
gru ((a -> Bool) -> [a] -> [a]
forall a. (a -> Bool) -> [a] -> [a]
dropWhile (a -> a -> Bool
forall a. Eq a => a -> a -> Bool
==a
x) [a]
xs)
          gru (a
x:[a]
xs) = a
x a -> [a] -> [a]
forall a. a -> [a] -> [a]
: [a] -> [a]
gru [a]
xs
          gru [] = []
          --findUnique xs = fu S.empty S.empty xs
          --    where fu _ uni [] = uni
          --          fu multi uni (y:ys)
          --              | y `S.member` multi = fu multi uni ys
          --              | y `S.member` uni = fu (S.insert y multi) (S.delete y uni) ys
          --              | otherwise = fu multi (S.insert y uni) ys
patientLcs0 [] [a]
_ = []
patientLcs0 [a]
_ [] = []

-- | ``LCS'' stands for ``Longest Common Subsequence,'' and it is a relatively
-- challenging problem to find an LCS efficiently.  I'm not going to explain
-- here what an LCS is, but will point out that it is useful in finding how
-- two sequences (lists, in this case) differ.  This module implements the
-- Hunt-Szymanski algorithm, which is appropriate for applications in which
-- the sequence is on an infinite alphabet, such as diffing the lines in two
-- files, where many, or most lines are unique.  In the best case scenario, a
-- permutation of unique lines, this algorithm is $O(n\log n)$.  In the worst
-- case scenario, that of a finite alphabet (i.e.\ where the number of elements
-- in the sequence is much greater than the number of unique elements), it is
-- an $O(n^2\log n)$ algorithm, which is pretty terrible.

{-# SPECIALIZE lcs ::[Hunk] -> [Hunk] -> [Hunk] #-}
lcs :: Ord a => [a] -> [a] -> [a]
lcs :: forall a. Ord a => [a] -> [a] -> [a]
lcs [] [a]
_ = []
lcs [a]
_ [] = []
lcs (a
c1:[a]
c1s) (a
c2:[a]
c2s)
    | a
c1 a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
c2 = a
c1a -> [a] -> [a]
forall a. a -> [a] -> [a]
: [a] -> [a] -> [a]
forall a. Ord a => [a] -> [a] -> [a]
lcs [a]
c1s [a]
c2s
    | Bool
otherwise =
        [a] -> [a]
forall a. [a] -> [a]
reverse ([a] -> [a]) -> [a] -> [a]
forall a b. (a -> b) -> a -> b
$ [a] -> [a] -> [a]
forall a. Ord a => [a] -> [a] -> [a]
lcsSimple ([a] -> [a]
forall a. [a] -> [a]
reverse (a
c1a -> [a] -> [a]
forall a. a -> [a] -> [a]
:[a]
c1s)) ([a] -> [a]
forall a. [a] -> [a]
reverse (a
c2a -> [a] -> [a]
forall a. a -> [a] -> [a]
:[a]
c2s))

lcsSimple :: Ord a => [a] -> [a] -> [a]
lcsSimple :: forall a. Ord a => [a] -> [a] -> [a]
lcsSimple [] [a]
_ = []
lcsSimple [a]
_ [] = []
lcsSimple s1 :: [a]
s1@(a
c1:[a]
c1s) s2 :: [a]
s2@(a
c2:[a]
c2s)
    | a
c1 a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
c2 = a
c1a -> [a] -> [a]
forall a. a -> [a] -> [a]
: [a] -> [a] -> [a]
forall a. Ord a => [a] -> [a] -> [a]
lcs [a]
c1s [a]
c2s
    | Bool
otherwise = [(a, [Hunk])] -> [a]
forall a. [(a, [Hunk])] -> [a]
hunt ([(a, [Hunk])] -> [a]) -> [(a, [Hunk])] -> [a]
forall a b. (a -> b) -> a -> b
$ [a] -> [[Hunk]] -> [(a, [Hunk])]
forall a. [a] -> [[Hunk]] -> [(a, [Hunk])]
pruneMatches [a]
s1 ([[Hunk]] -> [(a, [Hunk])]) -> [[Hunk]] -> [(a, [Hunk])]
forall a b. (a -> b) -> a -> b
$! [a] -> [a] -> [[Hunk]]
forall a. Ord a => [a] -> [a] -> [[Hunk]]
findMatches [a]
s1 [a]
s2

pruneMatches :: [a] -> [[Int]] -> [(a, [Int])]
pruneMatches :: forall a. [a] -> [[Hunk]] -> [(a, [Hunk])]
pruneMatches [a]
_ [] = []
pruneMatches [] [[Hunk]]
_ = []
pruneMatches (a
_:[a]
cs) ([]:[[Hunk]]
ms) = [a] -> [[Hunk]] -> [(a, [Hunk])]
forall a. [a] -> [[Hunk]] -> [(a, [Hunk])]
pruneMatches [a]
cs [[Hunk]]
ms
pruneMatches (a
c:[a]
cs) ([Hunk]
m:[[Hunk]]
ms) = (a
c,[Hunk]
m)(a, [Hunk]) -> [(a, [Hunk])] -> [(a, [Hunk])]
forall a. a -> [a] -> [a]
: [a] -> [[Hunk]] -> [(a, [Hunk])]
forall a. [a] -> [[Hunk]] -> [(a, [Hunk])]
pruneMatches [a]
cs [[Hunk]]
ms

type Threshold s a = STArray s Int (Int,[a])

hunt :: [(a, [Int])] -> [a]
hunt :: forall a. [(a, [Hunk])] -> [a]
hunt [] = []
hunt [(a, [Hunk])]
csmatches =
    (forall s. ST s [a]) -> [a]
forall a. (forall s. ST s a) -> a
runST ( do Threshold s a
th <- Hunk -> Hunk -> ST s (Threshold s a)
forall s a. Hunk -> Hunk -> ST s (Threshold s a)
emptyThreshold ([(a, [Hunk])] -> Hunk
forall a. [a] -> Hunk
forall (t :: * -> *) a. Foldable t => t a -> Hunk
length [(a, [Hunk])]
csmatches) Hunk
l
               [(a, [Hunk])] -> Threshold s a -> ST s ()
forall a s. [(a, [Hunk])] -> Threshold s a -> ST s ()
huntInternal [(a, [Hunk])]
csmatches Threshold s a
th
               Threshold s a -> Hunk -> Hunk -> ST s [a]
forall s a. Threshold s a -> Hunk -> Hunk -> ST s [a]
huntRecover Threshold s a
th (-Hunk
1) Hunk
l )
    where l :: Hunk
l = [Hunk] -> Hunk
forall a. Ord a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum (Hunk
0 Hunk -> [Hunk] -> [Hunk]
forall a. a -> [a] -> [a]
: [[Hunk]] -> [Hunk]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat (((a, [Hunk]) -> [Hunk]) -> [(a, [Hunk])] -> [[Hunk]]
forall a b. (a -> b) -> [a] -> [b]
map (a, [Hunk]) -> [Hunk]
forall a b. (a, b) -> b
snd [(a, [Hunk])]
csmatches))

huntInternal :: [(a, [Int])] -> Threshold s a -> ST s ()
huntInternal :: forall a s. [(a, [Hunk])] -> Threshold s a -> ST s ()
huntInternal [] Threshold s a
_ = () -> ST s ()
forall a. a -> ST s a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
huntInternal ((a
c,[Hunk]
m):[(a, [Hunk])]
csms) Threshold s a
th = do
    a -> [Hunk] -> Threshold s a -> ST s ()
forall a s. a -> [Hunk] -> Threshold s a -> ST s ()
huntOneChar a
c [Hunk]
m Threshold s a
th
    [(a, [Hunk])] -> Threshold s a -> ST s ()
forall a s. [(a, [Hunk])] -> Threshold s a -> ST s ()
huntInternal [(a, [Hunk])]
csms Threshold s a
th

huntOneChar :: a -> [Int] ->  Threshold s a -> ST s ()
huntOneChar :: forall a s. a -> [Hunk] -> Threshold s a -> ST s ()
huntOneChar a
_ [] Threshold s a
_ = () -> ST s ()
forall a. a -> ST s a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
huntOneChar a
c (Hunk
j:[Hunk]
js) Threshold s a
th = do
    Maybe Hunk
index_k <- Hunk -> Threshold s a -> ST s (Maybe Hunk)
forall s a. Hunk -> Threshold s a -> ST s (Maybe Hunk)
myBs Hunk
j Threshold s a
th
    case Maybe Hunk
index_k of
      Maybe Hunk
Nothing -> () -> ST s ()
forall a. a -> ST s a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
      Just Hunk
k -> do
        (Hunk
_, [a]
rest) <- Threshold s a -> Hunk -> ST s (Hunk, [a])
forall (a :: * -> * -> *) e (m :: * -> *) i.
(MArray a e m, Ix i) =>
a i e -> i -> m e
readArray Threshold s a
th (Hunk
kHunk -> Hunk -> Hunk
forall a. Num a => a -> a -> a
-Hunk
1)
        Threshold s a -> Hunk -> (Hunk, [a]) -> ST s ()
forall (a :: * -> * -> *) e (m :: * -> *) i.
(MArray a e m, Ix i) =>
a i e -> i -> e -> m ()
writeArray Threshold s a
th Hunk
k (Hunk
j, a
ca -> [a] -> [a]
forall a. a -> [a] -> [a]
:[a]
rest)
    a -> [Hunk] -> Threshold s a -> ST s ()
forall a s. a -> [Hunk] -> Threshold s a -> ST s ()
huntOneChar a
c [Hunk]
js Threshold s a
th

-- This is O(n), which is stupid.
huntRecover :: Threshold s a -> Int -> Int -> ST s [a]
huntRecover :: forall s a. Threshold s a -> Hunk -> Hunk -> ST s [a]
huntRecover Threshold s a
th Hunk
n Hunk
limit =
 do (Hunk
_, Hunk
th_max) <- Threshold s a -> ST s (Hunk, Hunk)
forall i. Ix i => STArray s i (Hunk, [a]) -> ST s (i, i)
forall (a :: * -> * -> *) e (m :: * -> *) i.
(MArray a e m, Ix i) =>
a i e -> m (i, i)
getBounds Threshold s a
th
    if Hunk
n Hunk -> Hunk -> Bool
forall a. Ord a => a -> a -> Bool
< Hunk
0
       then Threshold s a -> Hunk -> Hunk -> ST s [a]
forall s a. Threshold s a -> Hunk -> Hunk -> ST s [a]
huntRecover Threshold s a
th Hunk
th_max Hunk
limit
       else if Hunk
n Hunk -> Hunk -> Bool
forall a. Eq a => a -> a -> Bool
== Hunk
0 Bool -> Bool -> Bool
|| Hunk
n Hunk -> Hunk -> Bool
forall a. Ord a => a -> a -> Bool
> Hunk
th_max
            then [a] -> ST s [a]
forall a. a -> ST s a
forall (m :: * -> *) a. Monad m => a -> m a
return []
            else do (Hunk
thn, [a]
sn) <- Threshold s a -> Hunk -> ST s (Hunk, [a])
forall (a :: * -> * -> *) e (m :: * -> *) i.
(MArray a e m, Ix i) =>
a i e -> i -> m e
readArray Threshold s a
th Hunk
n
                    if Hunk
thn Hunk -> Hunk -> Bool
forall a. Ord a => a -> a -> Bool
<= Hunk
limit
                      then [a] -> ST s [a]
forall a. a -> ST s a
forall (m :: * -> *) a. Monad m => a -> m a
return ([a] -> ST s [a]) -> [a] -> ST s [a]
forall a b. (a -> b) -> a -> b
$ [a] -> [a]
forall a. [a] -> [a]
reverse [a]
sn
                      else Threshold s a -> Hunk -> Hunk -> ST s [a]
forall s a. Threshold s a -> Hunk -> Hunk -> ST s [a]
huntRecover Threshold s a
th (Hunk
nHunk -> Hunk -> Hunk
forall a. Num a => a -> a -> a
-Hunk
1) Hunk
limit

emptyThreshold :: Int -> Int -> ST s (Threshold s a)
emptyThreshold :: forall s a. Hunk -> Hunk -> ST s (Threshold s a)
emptyThreshold Hunk
l Hunk
th_max = do
  Threshold s a
th <- (Hunk, Hunk) -> (Hunk, [a]) -> ST s (Threshold s a)
forall i.
Ix i =>
(i, i) -> (Hunk, [a]) -> ST s (STArray s i (Hunk, [a]))
forall (a :: * -> * -> *) e (m :: * -> *) i.
(MArray a e m, Ix i) =>
(i, i) -> e -> m (a i e)
newArray (Hunk
0,Hunk
l) (Hunk
th_maxHunk -> Hunk -> Hunk
forall a. Num a => a -> a -> a
+Hunk
1, [])
  Threshold s a -> Hunk -> (Hunk, [a]) -> ST s ()
forall (a :: * -> * -> *) e (m :: * -> *) i.
(MArray a e m, Ix i) =>
a i e -> i -> e -> m ()
writeArray Threshold s a
th Hunk
0 (Hunk
0, [])
  Threshold s a -> ST s (Threshold s a)
forall a. a -> ST s a
forall (m :: * -> *) a. Monad m => a -> m a
return Threshold s a
th

myBs :: Int -> Threshold s a -> ST s (Maybe Int)
myBs :: forall s a. Hunk -> Threshold s a -> ST s (Maybe Hunk)
myBs Hunk
j Threshold s a
th = do (Hunk, Hunk)
bnds <- Threshold s a -> ST s (Hunk, Hunk)
forall i. Ix i => STArray s i (Hunk, [a]) -> ST s (i, i)
forall (a :: * -> * -> *) e (m :: * -> *) i.
(MArray a e m, Ix i) =>
a i e -> m (i, i)
getBounds Threshold s a
th
               Hunk -> (Hunk, Hunk) -> Threshold s a -> ST s (Maybe Hunk)
forall s a.
Hunk -> (Hunk, Hunk) -> Threshold s a -> ST s (Maybe Hunk)
myHelperBs Hunk
j (Hunk, Hunk)
bnds Threshold s a
th

myHelperBs :: Int -> (Int,Int) -> Threshold s a ->
                ST s (Maybe Int)
myHelperBs :: forall s a.
Hunk -> (Hunk, Hunk) -> Threshold s a -> ST s (Maybe Hunk)
myHelperBs Hunk
j (Hunk
th_min,Hunk
th_max) Threshold s a
th =
    if Hunk
th_max Hunk -> Hunk -> Hunk
forall a. Num a => a -> a -> a
- Hunk
th_min Hunk -> Hunk -> Bool
forall a. Ord a => a -> a -> Bool
> Hunk
1 then do
       (Hunk
midth, [a]
_) <- Threshold s a -> Hunk -> ST s (Hunk, [a])
forall (a :: * -> * -> *) e (m :: * -> *) i.
(MArray a e m, Ix i) =>
a i e -> i -> m e
readArray Threshold s a
th Hunk
th_middle
       if Hunk
j Hunk -> Hunk -> Bool
forall a. Ord a => a -> a -> Bool
> Hunk
midth
         then Hunk -> (Hunk, Hunk) -> Threshold s a -> ST s (Maybe Hunk)
forall s a.
Hunk -> (Hunk, Hunk) -> Threshold s a -> ST s (Maybe Hunk)
myHelperBs Hunk
j (Hunk
th_middle,Hunk
th_max) Threshold s a
th
         else Hunk -> (Hunk, Hunk) -> Threshold s a -> ST s (Maybe Hunk)
forall s a.
Hunk -> (Hunk, Hunk) -> Threshold s a -> ST s (Maybe Hunk)
myHelperBs Hunk
j (Hunk
th_min,Hunk
th_middle) Threshold s a
th
    else do
       (Hunk
minth, [a]
_) <- Threshold s a -> Hunk -> ST s (Hunk, [a])
forall (a :: * -> * -> *) e (m :: * -> *) i.
(MArray a e m, Ix i) =>
a i e -> i -> m e
readArray Threshold s a
th Hunk
th_min
       (Hunk
maxth, [a]
_) <- Threshold s a -> Hunk -> ST s (Hunk, [a])
forall (a :: * -> * -> *) e (m :: * -> *) i.
(MArray a e m, Ix i) =>
a i e -> i -> m e
readArray Threshold s a
th Hunk
th_max
       if Hunk
minth Hunk -> Hunk -> Bool
forall a. Ord a => a -> a -> Bool
< Hunk
j Bool -> Bool -> Bool
&& Hunk
maxth Hunk -> Hunk -> Bool
forall a. Ord a => a -> a -> Bool
> Hunk
j
          then Maybe Hunk -> ST s (Maybe Hunk)
forall a. a -> ST s a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe Hunk -> ST s (Maybe Hunk))
-> Maybe Hunk -> ST s (Maybe Hunk)
forall a b. (a -> b) -> a -> b
$ Hunk -> Maybe Hunk
forall a. a -> Maybe a
Just Hunk
th_max
          else if Hunk
j Hunk -> Hunk -> Bool
forall a. Ord a => a -> a -> Bool
< Hunk
minth then Maybe Hunk -> ST s (Maybe Hunk)
forall a. a -> ST s a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe Hunk -> ST s (Maybe Hunk))
-> Maybe Hunk -> ST s (Maybe Hunk)
forall a b. (a -> b) -> a -> b
$ Hunk -> Maybe Hunk
forall a. a -> Maybe a
Just Hunk
th_min
               else Maybe Hunk -> ST s (Maybe Hunk)
forall a. a -> ST s a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Hunk
forall a. Maybe a
Nothing
    where th_middle :: Hunk
th_middle = (Hunk
th_maxHunk -> Hunk -> Hunk
forall a. Num a => a -> a -> a
+Hunk
th_min) Hunk -> Hunk -> Hunk
forall a. Integral a => a -> a -> a
`div` Hunk
2



findMatches :: Ord a => [a] -> [a] -> [[Int]]
findMatches :: forall a. Ord a => [a] -> [a] -> [[Hunk]]
findMatches [] [] = []
findMatches [] (a
_:[a]
bs) = [][Hunk] -> [[Hunk]] -> [[Hunk]]
forall a. a -> [a] -> [a]
: [a] -> [a] -> [[Hunk]]
forall a. Ord a => [a] -> [a] -> [[Hunk]]
findMatches [] [a]
bs
findMatches [a]
_ [] = []
findMatches [a]
a [a]
b =
    [(Hunk, [Hunk])] -> [[Hunk]]
forall a. [(Hunk, [a])] -> [[a]]
unzipIndexed ([(Hunk, [Hunk])] -> [[Hunk]]) -> [(Hunk, [Hunk])] -> [[Hunk]]
forall a b. (a -> b) -> a -> b
$ [(Hunk, [Hunk])] -> [(Hunk, [Hunk])]
forall a. Ord a => [a] -> [a]
sort ([(Hunk, [Hunk])] -> [(Hunk, [Hunk])])
-> [(Hunk, [Hunk])] -> [(Hunk, [Hunk])]
forall a b. (a -> b) -> a -> b
$ [(a, Hunk)] -> [(a, Hunk)] -> [a] -> [Hunk] -> [(Hunk, [Hunk])]
forall a.
Ord a =>
[(a, Hunk)] -> [(a, Hunk)] -> [a] -> [Hunk] -> [(Hunk, [Hunk])]
findSortedMatches [(a, Hunk)]
indexeda [(a, Hunk)]
indexedb [] []
    where indexeda :: [(a, Hunk)]
indexeda = [(a, Hunk)] -> [(a, Hunk)]
forall a. Ord a => [a] -> [a]
sort ([(a, Hunk)] -> [(a, Hunk)]) -> [(a, Hunk)] -> [(a, Hunk)]
forall a b. (a -> b) -> a -> b
$ [a] -> [Hunk] -> [(a, Hunk)]
forall a b. [a] -> [b] -> [(a, b)]
zip [a]
a [Hunk
1..]
          indexedb :: [(a, Hunk)]
indexedb = [(a, Hunk)] -> [(a, Hunk)]
forall a. Ord a => [a] -> [a]
sort ([(a, Hunk)] -> [(a, Hunk)]) -> [(a, Hunk)] -> [(a, Hunk)]
forall a b. (a -> b) -> a -> b
$ [a] -> [Hunk] -> [(a, Hunk)]
forall a b. [a] -> [b] -> [(a, b)]
zip [a]
b [Hunk
1..]

unzipIndexed :: [(Int,[a])] -> [[a]]
unzipIndexed :: forall a. [(Hunk, [a])] -> [[a]]
unzipIndexed [(Hunk, [a])]
s = Hunk -> [(Hunk, [a])] -> [[a]]
forall {t} {a}. (Eq t, Num t) => t -> [(t, [a])] -> [[a]]
unzipIndexedHelper Hunk
1 [(Hunk, [a])]
s
    where unzipIndexedHelper :: t -> [(t, [a])] -> [[a]]
unzipIndexedHelper t
_ [] = []
          unzipIndexedHelper t
thisl ((t
l,[a]
c):[(t, [a])]
rest)
           | t
thisl t -> t -> Bool
forall a. Eq a => a -> a -> Bool
== t
l = [a]
c[a] -> [[a]] -> [[a]]
forall a. a -> [a] -> [a]
: t -> [(t, [a])] -> [[a]]
unzipIndexedHelper (t
lt -> t -> t
forall a. Num a => a -> a -> a
+t
1) [(t, [a])]
rest
           | Bool
otherwise = [][a] -> [[a]] -> [[a]]
forall a. a -> [a] -> [a]
: t -> [(t, [a])] -> [[a]]
unzipIndexedHelper (t
thislt -> t -> t
forall a. Num a => a -> a -> a
+t
1) ((t
l,[a]
c)(t, [a]) -> [(t, [a])] -> [(t, [a])]
forall a. a -> [a] -> [a]
:[(t, [a])]
rest)

findSortedMatches :: Ord a => [(a, Int)] -> [(a, Int)] -> [a] -> [Int]
                             -> [(Int, [Int])]
findSortedMatches :: forall a.
Ord a =>
[(a, Hunk)] -> [(a, Hunk)] -> [a] -> [Hunk] -> [(Hunk, [Hunk])]
findSortedMatches [] [(a, Hunk)]
_ [a]
_ [Hunk]
_ = []
findSortedMatches [(a, Hunk)]
_ [] [a]
_ [Hunk]
_ = []
findSortedMatches ((a
a,Hunk
na):[(a, Hunk)]
as) ((a
b,Hunk
nb):[(a, Hunk)]
bs) [a]
aold [Hunk]
aoldmatches
    | [a
a] [a] -> [a] -> Bool
forall a. Eq a => a -> a -> Bool
== [a]
aold = (Hunk
na, [Hunk]
aoldmatches) (Hunk, [Hunk]) -> [(Hunk, [Hunk])] -> [(Hunk, [Hunk])]
forall a. a -> [a] -> [a]
:
                    [(a, Hunk)] -> [(a, Hunk)] -> [a] -> [Hunk] -> [(Hunk, [Hunk])]
forall a.
Ord a =>
[(a, Hunk)] -> [(a, Hunk)] -> [a] -> [Hunk] -> [(Hunk, [Hunk])]
findSortedMatches [(a, Hunk)]
as ((a
b,Hunk
nb)(a, Hunk) -> [(a, Hunk)] -> [(a, Hunk)]
forall a. a -> [a] -> [a]
:[(a, Hunk)]
bs) [a]
aold [Hunk]
aoldmatches
    | a
a a -> a -> Bool
forall a. Ord a => a -> a -> Bool
> a
b = [(a, Hunk)] -> [(a, Hunk)] -> [a] -> [Hunk] -> [(Hunk, [Hunk])]
forall a.
Ord a =>
[(a, Hunk)] -> [(a, Hunk)] -> [a] -> [Hunk] -> [(Hunk, [Hunk])]
findSortedMatches ((a
a,Hunk
na)(a, Hunk) -> [(a, Hunk)] -> [(a, Hunk)]
forall a. a -> [a] -> [a]
:[(a, Hunk)]
as) [(a, Hunk)]
bs [a]
aold [Hunk]
aoldmatches
    | a
a a -> a -> Bool
forall a. Ord a => a -> a -> Bool
< a
b = [(a, Hunk)] -> [(a, Hunk)] -> [a] -> [Hunk] -> [(Hunk, [Hunk])]
forall a.
Ord a =>
[(a, Hunk)] -> [(a, Hunk)] -> [a] -> [Hunk] -> [(Hunk, [Hunk])]
findSortedMatches [(a, Hunk)]
as ((a
b,Hunk
nb)(a, Hunk) -> [(a, Hunk)] -> [(a, Hunk)]
forall a. a -> [a] -> [a]
:[(a, Hunk)]
bs) [a]
aold [Hunk]
aoldmatches
-- following line is inefficient if a line is repeated many times.
findSortedMatches ((a
a,Hunk
na):[(a, Hunk)]
as) [(a, Hunk)]
bs [a]
_ [Hunk]
_ -- a == b
      = (Hunk
na, [Hunk]
matches) (Hunk, [Hunk]) -> [(Hunk, [Hunk])] -> [(Hunk, [Hunk])]
forall a. a -> [a] -> [a]
: [(a, Hunk)] -> [(a, Hunk)] -> [a] -> [Hunk] -> [(Hunk, [Hunk])]
forall a.
Ord a =>
[(a, Hunk)] -> [(a, Hunk)] -> [a] -> [Hunk] -> [(Hunk, [Hunk])]
findSortedMatches [(a, Hunk)]
as [(a, Hunk)]
bs [a
a] [Hunk]
matches
    where matches :: [Hunk]
matches = [Hunk] -> [Hunk]
forall a. [a] -> [a]
reverse ([Hunk] -> [Hunk]) -> [Hunk] -> [Hunk]
forall a b. (a -> b) -> a -> b
$ ((a, Hunk) -> Hunk) -> [(a, Hunk)] -> [Hunk]
forall a b. (a -> b) -> [a] -> [b]
map (a, Hunk) -> Hunk
forall a b. (a, b) -> b
snd ([(a, Hunk)] -> [Hunk]) -> [(a, Hunk)] -> [Hunk]
forall a b. (a -> b) -> a -> b
$ ((a, Hunk) -> Bool) -> [(a, Hunk)] -> [(a, Hunk)]
forall a. (a -> Bool) -> [a] -> [a]
filter ((a -> a -> Bool
forall a. Eq a => a -> a -> Bool
==a
a) (a -> Bool) -> ((a, Hunk) -> a) -> (a, Hunk) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a, Hunk) -> a
forall a b. (a, b) -> a
fst) [(a, Hunk)]
bs