module Darcs.Util.Diff.Patience
( getChanges
) where
import Prelude ()
import Darcs.Prelude
import Data.List ( sort )
import Data.Maybe ( fromJust )
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 = Int -> HMap Int [(Int, ByteString)] -> HunkMap
HunkMapInfo 0 HMap Int [(Int, ByteString)]
forall k a. Map k a
M.empty
getChanges :: [B.ByteString] -> [B.ByteString]
-> [(Int,[B.ByteString],[B.ByteString])]
getChanges :: [ByteString] -> [ByteString] -> [(Int, [ByteString], [ByteString])]
getChanges a :: [ByteString]
a b :: [ByteString]
b = PArray -> PArray -> Int -> [(Int, [ByteString], [ByteString])]
dropStart ([ByteString] -> PArray
initP [ByteString]
a) ([ByteString] -> PArray
initP [ByteString]
b) 1
dropStart :: PArray -> PArray -> Int
-> [(Int,[B.ByteString],[B.ByteString])]
dropStart :: PArray -> PArray -> Int -> [(Int, [ByteString], [ByteString])]
dropStart a :: PArray
a b :: PArray
b off :: Int
off
| Int
off Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> PArray -> Int
forall (a :: * -> * -> *) e. IArray a e => a Int e -> Int
aLen PArray
a = [(Int
off Int -> Int -> Int
forall a. Num a => a -> a -> a
- 1, [], PArray -> Int -> Int -> [ByteString]
getSlice PArray
b Int
off (PArray -> Int
forall (a :: * -> * -> *) e. IArray a e => a Int e -> Int
aLen PArray
b))]
| Int
off Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> PArray -> Int
forall (a :: * -> * -> *) e. IArray a e => a Int e -> Int
aLen PArray
b = [(Int
off Int -> Int -> Int
forall a. Num a => a -> a -> a
- 1, PArray -> Int -> Int -> [ByteString]
getSlice PArray
a Int
off (PArray -> Int
forall (a :: * -> * -> *) e. IArray a e => a Int e -> Int
aLen PArray
a), [])]
| PArray
aPArray -> Int -> ByteString
forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
a i e -> i -> e
!Int
off ByteString -> ByteString -> Bool
forall a. Eq a => a -> a -> Bool
== PArray
bPArray -> Int -> ByteString
forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
a i e -> i -> e
!Int
off = PArray -> PArray -> Int -> [(Int, [ByteString], [ByteString])]
dropStart PArray
a PArray
b (Int
off Int -> Int -> Int
forall a. Num a => a -> a -> a
+ 1)
| Bool
otherwise = PArray
-> PArray -> Int -> Int -> [(Int, [ByteString], [ByteString])]
dropEnd PArray
a PArray
b Int
off 0
dropEnd :: PArray -> PArray -> Int -> Int
-> [(Int,[B.ByteString],[B.ByteString])]
dropEnd :: PArray
-> PArray -> Int -> Int -> [(Int, [ByteString], [ByteString])]
dropEnd a :: PArray
a b :: PArray
b off :: Int
off end :: Int
end
| Int
off Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
alast = [(Int
off Int -> Int -> Int
forall a. Num a => a -> a -> a
- 1, [], PArray -> Int -> Int -> [ByteString]
getSlice PArray
b Int
off Int
blast)]
| Int
off Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
blast = [(Int
off Int -> Int -> Int
forall a. Num a => a -> a -> a
- 1, PArray -> Int -> Int -> [ByteString]
getSlice PArray
a Int
off Int
alast, [])]
| PArray
aPArray -> Int -> ByteString
forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
a i e -> i -> e
!Int
alast ByteString -> ByteString -> Bool
forall a. Eq a => a -> a -> Bool
== PArray
bPArray -> Int -> ByteString
forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
a i e -> i -> e
!Int
blast = PArray
-> PArray -> Int -> Int -> [(Int, [ByteString], [ByteString])]
dropEnd PArray
a PArray
b Int
off (Int
end Int -> Int -> Int
forall a. Num a => a -> a -> a
+ 1)
| Bool
otherwise = Int
-> [ByteString]
-> [ByteString]
-> [(Int, [ByteString], [ByteString])]
getChanges' (Int
offInt -> Int -> Int
forall a. Num a => a -> a -> a
-1) (PArray -> Int -> Int -> [ByteString]
getSlice PArray
a Int
off (PArray -> Int
forall (a :: * -> * -> *) e. IArray a e => a Int e -> Int
aLen PArray
a Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
end')) (PArray -> Int -> Int -> [ByteString]
getSlice PArray
b Int
off (PArray -> Int
forall (a :: * -> * -> *) e. IArray a e => a Int e -> Int
aLen PArray
b Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
end'))
where end' :: Int
end' = Int -> Int
addBorings Int
end
addBorings :: Int -> Int
addBorings e :: Int
e | Int
e Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> 0 Bool -> Bool -> Bool
&& PArray
aPArray -> Int -> ByteString
forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
a i e -> i -> e
!(PArray -> Int
forall (a :: * -> * -> *) e. IArray a e => a Int e -> Int
aLen PArray
a Int -> Int -> Int
forall a. Num a => a -> a -> a
- (Int
eInt -> Int -> Int
forall a. Num a => a -> a -> a
-1)) ByteString -> [ByteString] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [ByteString]
borings' = Int -> Int
addBorings (Int
eInt -> Int -> Int
forall a. Num a => a -> a -> a
-1)
| Bool
otherwise = Int
e
alast :: Int
alast = PArray -> Int
forall (a :: * -> * -> *) e. IArray a e => a Int e -> Int
aLen PArray
a Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
end
blast :: Int
blast = PArray -> Int
forall (a :: * -> * -> *) e. IArray a e => a Int e -> Int
aLen PArray
b Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
end
getChanges' :: Int -> [B.ByteString] -> [B.ByteString]
-> [(Int, [B.ByteString], [B.ByteString])]
getChanges' :: Int
-> [ByteString]
-> [ByteString]
-> [(Int, [ByteString], [ByteString])]
getChanges' off :: Int
off o :: [ByteString]
o n :: [ByteString]
n = [(Int, [ByteString], [ByteString])]
-> [(Int, [Int], [Int])] -> [(Int, [ByteString], [ByteString])]
forall a.
[(a, [ByteString], [ByteString])]
-> [(a, [Int], [Int])] -> [(a, [ByteString], [ByteString])]
convertLBS [] ([(Int, [Int], [Int])] -> [(Int, [ByteString], [ByteString])])
-> [(Int, [Int], [Int])] -> [(Int, [ByteString], [ByteString])]
forall a b. (a -> b) -> a -> b
$ [[Int] -> [[Int]]]
-> Int -> [Int] -> [Int] -> [(Int, [Int], [Int])]
genNestedChanges [[Int] -> [[Int]]
byparagraph, [Int] -> [[Int]]
bylines] Int
off [Int]
oh [Int]
nh
where
(_,m' :: HunkMap
m') = [ByteString] -> HunkMap -> ([Int], HunkMap)
listToHunk [ByteString]
borings' HunkMap
empty
(oh :: [Int]
oh,m :: HunkMap
m) = [ByteString] -> HunkMap -> ([Int], HunkMap)
listToHunk [ByteString]
o HunkMap
m'
(nh :: [Int]
nh,lmap :: HunkMap
lmap) = [ByteString] -> HunkMap -> ([Int], HunkMap)
listToHunk [ByteString]
n HunkMap
m
convertLBS :: [(a, [ByteString], [ByteString])]
-> [(a, [Int], [Int])] -> [(a, [ByteString], [ByteString])]
convertLBS ys :: [(a, [ByteString], [ByteString])]
ys [] = [(a, [ByteString], [ByteString])]
-> [(a, [ByteString], [ByteString])]
forall a. [a] -> [a]
reverse [(a, [ByteString], [ByteString])]
ys
convertLBS ys :: [(a, [ByteString], [ByteString])]
ys ((i :: a
i,os :: [Int]
os,ns :: [Int]
ns):xs :: [(a, [Int], [Int])]
xs) = [(a, [ByteString], [ByteString])]
-> [(a, [Int], [Int])] -> [(a, [ByteString], [ByteString])]
convertLBS ((a
i, [Int] -> [ByteString]
hunkToBS [Int]
os, [Int] -> [ByteString]
hunkToBS [Int]
ns)(a, [ByteString], [ByteString])
-> [(a, [ByteString], [ByteString])]
-> [(a, [ByteString], [ByteString])]
forall a. a -> [a] -> [a]
:[(a, [ByteString], [ByteString])]
ys) [(a, [Int], [Int])]
xs
hunkToBS :: [Int] -> [ByteString]
hunkToBS hs :: [Int]
hs = (Int -> ByteString) -> [Int] -> [ByteString]
forall a b. (a -> b) -> [a] -> [b]
map (\h :: Int
h -> (!) PArray
harray (Int -> Int
forall a. Num a => a -> a
abs Int
h)) [Int]
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 Int [(Int, ByteString)]
getMap (HunkMapInfo _ m :: HMap Int [(Int, ByteString)]
m) = HMap Int [(Int, ByteString)]
m
getSize :: HunkMap -> Int
getSize :: HunkMap -> Int
getSize (HunkMapInfo s :: Int
s _) = Int
s
getBArray :: HunkMap -> Array Hunk B.ByteString
getBArray :: HunkMap -> PArray
getBArray (HunkMapInfo size :: Int
size b :: HMap Int [(Int, ByteString)]
b) = (Int, Int) -> [(Int, ByteString)] -> PArray
forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
(i, i) -> [(i, e)] -> a i e
array (1,Int
size) ([(Int, ByteString)] -> PArray) -> [(Int, ByteString)] -> PArray
forall a b. (a -> b) -> a -> b
$ ((Int, ByteString) -> (Int, ByteString))
-> [(Int, ByteString)] -> [(Int, ByteString)]
forall a b. (a -> b) -> [a] -> [b]
map (\(x :: Int
x,a :: ByteString
a) -> (Int -> Int
forall a. Num a => a -> a
abs Int
x, ByteString
a)) ([(Int, ByteString)] -> [(Int, ByteString)])
-> [(Int, ByteString)] -> [(Int, ByteString)]
forall a b. (a -> b) -> a -> b
$ [[(Int, ByteString)]] -> [(Int, ByteString)]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[(Int, ByteString)]] -> [(Int, ByteString)])
-> [[(Int, ByteString)]] -> [(Int, ByteString)]
forall a b. (a -> b) -> a -> b
$ HMap Int [(Int, ByteString)] -> [[(Int, ByteString)]]
forall k a. Map k a -> [a]
M.elems HMap Int [(Int, ByteString)]
b
insert :: Hash -> B.ByteString -> HunkMap -> (Hunk, HunkMap)
insert :: Int -> ByteString -> HunkMap -> (Int, HunkMap)
insert h :: Int
h bs :: ByteString
bs hmap :: HunkMap
hmap = (Int
hunknumber, Int -> HMap Int [(Int, ByteString)] -> HunkMap
HunkMapInfo Int
newsize (([(Int, ByteString)] -> [(Int, ByteString)] -> [(Int, ByteString)])
-> Int
-> [(Int, ByteString)]
-> HMap Int [(Int, ByteString)]
-> HMap Int [(Int, ByteString)]
forall k a. Ord k => (a -> a -> a) -> k -> a -> Map k a -> Map k a
M.insertWith (\_ o :: [(Int, ByteString)]
o -> (Int
hunknumber,ByteString
bs)(Int, ByteString) -> [(Int, ByteString)] -> [(Int, ByteString)]
forall a. a -> [a] -> [a]
:[(Int, ByteString)]
o) Int
h [(Int
hunknumber,ByteString
bs)] (HMap Int [(Int, ByteString)] -> HMap Int [(Int, ByteString)])
-> HMap Int [(Int, ByteString)] -> HMap Int [(Int, ByteString)]
forall a b. (a -> b) -> a -> b
$ HunkMap -> HMap Int [(Int, ByteString)]
getMap HunkMap
hmap))
where hunknumber :: Int
hunknumber = if Word8 -> ByteString -> Bool
B.elem Word8
nl ByteString
bs then -Int
newsize
else Int
newsize
newsize :: Int
newsize = HunkMap -> Int
getSize HunkMap
hmapInt -> Int -> Int
forall a. Num a => a -> a -> a
+1
nl :: Word8
nl = 10
toHunk' :: HunkMap -> B.ByteString -> (Hunk, HunkMap)
toHunk' :: HunkMap -> ByteString -> (Int, HunkMap)
toHunk' lmap :: HunkMap
lmap bs :: ByteString
bs | Maybe [(Int, ByteString)]
oldbs Maybe [(Int, ByteString)] -> Maybe [(Int, ByteString)] -> Bool
forall a. Eq a => a -> a -> Bool
== Maybe [(Int, ByteString)]
forall a. Maybe a
Nothing Bool -> Bool -> Bool
|| [(Int, ByteString)] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [(Int, ByteString)]
oldhunkpair = Int -> ByteString -> HunkMap -> (Int, HunkMap)
insert Int
hash ByteString
bs HunkMap
lmap
| Bool
otherwise = ((Int, ByteString) -> Int
forall a b. (a, b) -> a
fst ((Int, ByteString) -> Int) -> (Int, ByteString) -> Int
forall a b. (a -> b) -> a -> b
$ [(Int, ByteString)] -> (Int, ByteString)
forall a. [a] -> a
head [(Int, ByteString)]
oldhunkpair, HunkMap
lmap)
where hash :: Int
hash = ByteString -> Int
forall a. Hashable a => a -> Int
H.hash ByteString
bs
oldbs :: Maybe [(Int, ByteString)]
oldbs = Int -> HMap Int [(Int, ByteString)] -> Maybe [(Int, ByteString)]
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup Int
hash (HunkMap -> HMap Int [(Int, ByteString)]
getMap HunkMap
lmap)
oldhunkpair :: [(Int, ByteString)]
oldhunkpair = ((Int, ByteString) -> Bool)
-> [(Int, ByteString)] -> [(Int, ByteString)]
forall a. (a -> Bool) -> [a] -> [a]
filter ((ByteString -> ByteString -> Bool
forall a. Eq a => a -> a -> Bool
== ByteString
bs) (ByteString -> Bool)
-> ((Int, ByteString) -> ByteString) -> (Int, ByteString) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int, ByteString) -> ByteString
forall a b. (a, b) -> b
snd) ([(Int, ByteString)] -> [(Int, ByteString)])
-> [(Int, ByteString)] -> [(Int, ByteString)]
forall a b. (a -> b) -> a -> b
$ Maybe [(Int, ByteString)] -> [(Int, ByteString)]
forall a. HasCallStack => Maybe a -> a
fromJust Maybe [(Int, ByteString)]
oldbs
listToHunk :: [B.ByteString] -> HunkMap -> ([Hunk], HunkMap)
listToHunk :: [ByteString] -> HunkMap -> ([Int], HunkMap)
listToHunk [] hmap :: HunkMap
hmap = ([], HunkMap
hmap)
listToHunk (x :: ByteString
x:xs :: [ByteString]
xs) hmap :: HunkMap
hmap = let (y :: Int
y, hmap' :: HunkMap
hmap') = HunkMap -> ByteString -> (Int, HunkMap)
toHunk' HunkMap
hmap ByteString
x
(ys :: [Int]
ys, hmap'' :: HunkMap
hmap'') = [ByteString] -> HunkMap -> ([Int], HunkMap)
listToHunk [ByteString]
xs HunkMap
hmap'
in (Int
yInt -> [Int] -> [Int]
forall a. a -> [a] -> [a]
:[Int]
ys, HunkMap
hmap'')
genNestedChanges :: [[Hunk] -> [[Hunk]]]
-> Int -> [Hunk] -> [Hunk]
-> [(Int, [Hunk], [Hunk])]
genNestedChanges :: [[Int] -> [[Int]]]
-> Int -> [Int] -> [Int] -> [(Int, [Int], [Int])]
genNestedChanges (br :: [Int] -> [[Int]]
br:brs :: [[Int] -> [[Int]]]
brs) i0 :: Int
i0 o0 :: [Int]
o0 n0 :: [Int]
n0 = Int -> [[Int]] -> [[Int]] -> [[Int]] -> [(Int, [Int], [Int])]
nc Int
i0 ([[Int]] -> [[Int]] -> [[Int]]
forall a. Ord a => [a] -> [a] -> [a]
lcus [[Int]]
ol [[Int]]
nl) [[Int]]
ol [[Int]]
nl
where nl :: [[Int]]
nl = [Int] -> [[Int]]
br [Int]
n0
ol :: [[Int]]
ol = [Int] -> [[Int]]
br [Int]
o0
nc :: Int -> [[Int]] -> [[Int]] -> [[Int]] -> [(Int, [Int], [Int])]
nc i :: Int
i [] o :: [[Int]]
o n :: [[Int]]
n = Int -> [[Int]] -> [[Int]] -> [(Int, [Int], [Int])]
forall (t :: * -> *) (t :: * -> *).
(Foldable t, Foldable t) =>
Int -> t [Int] -> t [Int] -> [(Int, [Int], [Int])]
easydiff Int
i [[Int]]
o [[Int]]
n
nc i :: Int
i (x :: [Int]
x:xs :: [[Int]]
xs) o :: [[Int]]
o n :: [[Int]]
n =
case ([Int] -> Bool) -> [[Int]] -> ([[Int]], [[Int]])
forall a. (a -> Bool) -> [a] -> ([a], [a])
break ([Int] -> [Int] -> Bool
forall a. Eq a => a -> a -> Bool
==[Int]
x) [[Int]]
o of
(oa :: [[Int]]
oa, _:ob :: [[Int]]
ob) ->
case ([Int] -> Bool) -> [[Int]] -> ([[Int]], [[Int]])
forall a. (a -> Bool) -> [a] -> ([a], [a])
break ([Int] -> [Int] -> Bool
forall a. Eq a => a -> a -> Bool
==[Int]
x) [[Int]]
n of
(na :: [[Int]]
na, _:nb :: [[Int]]
nb) ->
Int
i' Int -> [(Int, [Int], [Int])] -> [(Int, [Int], [Int])]
forall a b. a -> b -> b
`seq` Int -> [[Int]] -> [[Int]] -> [(Int, [Int], [Int])]
forall (t :: * -> *) (t :: * -> *).
(Foldable t, Foldable t) =>
Int -> t [Int] -> t [Int] -> [(Int, [Int], [Int])]
easydiff Int
i [[Int]]
oa [[Int]]
na [(Int, [Int], [Int])]
-> [(Int, [Int], [Int])] -> [(Int, [Int], [Int])]
forall a. [a] -> [a] -> [a]
++ Int -> [[Int]] -> [[Int]] -> [[Int]] -> [(Int, [Int], [Int])]
nc Int
i' [[Int]]
xs [[Int]]
ob [[Int]]
nb
where i' :: Int
i' = Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ [Int] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ([[Int]] -> [Int]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[Int]]
na) Int -> Int -> Int
forall a. Num a => a -> a -> a
+ [Int] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Int]
x
(_,[]) -> [(Int, [Int], [Int])]
forall a. a
impossible
(_,[]) -> [(Int, [Int], [Int])]
forall a. a
impossible
easydiff :: Int -> t [Int] -> t [Int] -> [(Int, [Int], [Int])]
easydiff i :: Int
i o :: t [Int]
o n :: t [Int]
n = [[Int] -> [[Int]]]
-> Int -> [Int] -> [Int] -> [(Int, [Int], [Int])]
genNestedChanges [[Int] -> [[Int]]]
brs Int
i [Int]
oo [Int]
nn
where (oo :: [Int]
oo, nn :: [Int]
nn) = (t [Int] -> [Int]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat t [Int]
o, t [Int] -> [Int]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat t [Int]
n)
genNestedChanges [] i :: Int
i o :: [Int]
o n :: [Int]
n = ([Int] -> Bool)
-> Int -> [Int] -> [Int] -> [Int] -> [(Int, [Int], [Int])]
forall a.
Ord a =>
([a] -> Bool) -> Int -> [a] -> [a] -> [a] -> [(Int, [a], [a])]
mkdiff ((Int -> Bool) -> [Int] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (Int -> [Int] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Int]
borings)) Int
i [Int]
mylcs [Int]
o [Int]
n
where mylcs :: [Int]
mylcs = [Int] -> [Int] -> [Int]
forall a. Ord a => [a] -> [a] -> [a]
patientLcs ((Int -> Bool) -> [Int] -> [Int]
forall a. (a -> Bool) -> [a] -> [a]
filter (Int -> [Int] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` [Int]
borings) [Int]
o)
((Int -> Bool) -> [Int] -> [Int]
forall a. (a -> Bool) -> [a] -> [a]
filter (Int -> [Int] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` [Int]
borings) [Int]
n)
borings :: [Hunk]
borings :: [Int]
borings = ([Int], HunkMap) -> [Int]
forall a b. (a, b) -> a
fst (([Int], HunkMap) -> [Int]) -> ([Int], HunkMap) -> [Int]
forall a b. (a -> b) -> a -> b
$ [ByteString] -> HunkMap -> ([Int], HunkMap)
listToHunk [ByteString]
borings' HunkMap
empty
borings' :: [B.ByteString]
borings' :: [ByteString]
borings' = (String -> ByteString) -> [String] -> [ByteString]
forall a b. (a -> b) -> [a] -> [b]
map String -> ByteString
BC.pack ["", "\n", " ", ")", "(", ","]
byparagraph :: [Hunk] -> [[Hunk]]
byparagraph :: [Int] -> [[Int]]
byparagraph = [[Int]] -> [[Int]]
forall a. [a] -> [a]
reverse ([[Int]] -> [[Int]]) -> ([Int] -> [[Int]]) -> [Int] -> [[Int]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([Int] -> [Int]) -> [[Int]] -> [[Int]]
forall a b. (a -> b) -> [a] -> [b]
map [Int] -> [Int]
forall a. [a] -> [a]
reverse ([[Int]] -> [[Int]]) -> ([Int] -> [[Int]]) -> [Int] -> [[Int]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [[Int]] -> [Int] -> [[Int]]
byparagraphAcc []
where byparagraphAcc :: [[Int]] -> [Int] -> [[Int]]
byparagraphAcc xs :: [[Int]]
xs [] = [[Int]]
xs
byparagraphAcc [] (a :: Int
a:b :: Int
b:c :: Int
c:d :: [Int]
d)
| Int
a Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
nl Bool -> Bool -> Bool
&& Int
c Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
nl Bool -> Bool -> Bool
&& Int
b Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
hnull = case [Int]
d of
[] -> [[Int
c,Int
b,Int
a]]
_ -> [[Int]] -> [Int] -> [[Int]]
byparagraphAcc [[],[Int
c,Int
b,Int
a]] [Int]
d
byparagraphAcc [] (a :: Int
a:as :: [Int]
as) = [[Int]] -> [Int] -> [[Int]]
byparagraphAcc [[Int
a]] [Int]
as
byparagraphAcc (x :: [Int]
x:xs :: [[Int]]
xs) (a :: Int
a:b :: Int
b:c :: Int
c:d :: [Int]
d)
| Int
a Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
nl Bool -> Bool -> Bool
&& Int
c Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
nl Bool -> Bool -> Bool
&& Int
b Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
hnull = case [Int]
d of
[] -> (Int
cInt -> [Int] -> [Int]
forall a. a -> [a] -> [a]
:Int
bInt -> [Int] -> [Int]
forall a. a -> [a] -> [a]
:Int
aInt -> [Int] -> [Int]
forall a. a -> [a] -> [a]
:[Int]
x)[Int] -> [[Int]] -> [[Int]]
forall a. a -> [a] -> [a]
:[[Int]]
xs
_ -> [[Int]] -> [Int] -> [[Int]]
byparagraphAcc ([][Int] -> [[Int]] -> [[Int]]
forall a. a -> [a] -> [a]
:((Int
cInt -> [Int] -> [Int]
forall a. a -> [a] -> [a]
:Int
bInt -> [Int] -> [Int]
forall a. a -> [a] -> [a]
:Int
aInt -> [Int] -> [Int]
forall a. a -> [a] -> [a]
:[Int]
x)[Int] -> [[Int]] -> [[Int]]
forall a. a -> [a] -> [a]
:[[Int]]
xs)) [Int]
d
byparagraphAcc (x :: [Int]
x:xs :: [[Int]]
xs) (a :: Int
a:as :: [Int]
as) = [[Int]] -> [Int] -> [[Int]]
byparagraphAcc ((Int
aInt -> [Int] -> [Int]
forall a. a -> [a] -> [a]
:[Int]
x)[Int] -> [[Int]] -> [[Int]]
forall a. a -> [a] -> [a]
:[[Int]]
xs) [Int]
as
nl :: Int
nl = -1
hnull :: Int
hnull = 1
bylines :: [Hunk] -> [[Hunk]]
bylines :: [Int] -> [[Int]]
bylines = [[Int]] -> [[Int]]
forall a. [a] -> [a]
reverse ([[Int]] -> [[Int]]) -> ([Int] -> [[Int]]) -> [Int] -> [[Int]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [[Int]] -> [Int] -> [[Int]]
forall a. (Ord a, Num a) => [[a]] -> [a] -> [[a]]
bylinesAcc []
where bylinesAcc :: [[a]] -> [a] -> [[a]]
bylinesAcc ![[a]]
ys [] = [[a]]
ys
bylinesAcc ![[a]]
ys xs :: [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
<0) [a]
xs of
(_,[]) -> [a]
xs[a] -> [[a]] -> [[a]]
forall a. a -> [a] -> [a]
:[[a]]
ys
(a :: [a]
a,n :: a
n:b :: [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
lcus :: Ord a => [a] -> [a] -> [a]
lcus :: [a] -> [a] -> [a]
lcus xs0 :: [a]
xs0 ys0 :: [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 xs :: [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 (x :: a
x:x' :: a
x':xs :: [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 (x :: a
x:xs :: [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 :: ([a] -> Bool) -> Int -> [a] -> [a] -> [a] -> [(Int, [a], [a])]
mkdiff b :: [a] -> Bool
b ny :: Int
ny (l :: a
l:ls :: [a]
ls) (x :: a
x:xs :: [a]
xs) (y :: a
y:ys :: [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) -> Int -> [a] -> [a] -> [a] -> [(Int, [a], [a])]
forall a.
Ord a =>
([a] -> Bool) -> Int -> [a] -> [a] -> [a] -> [(Int, [a], [a])]
mkdiff [a] -> Bool
b (Int
nyInt -> Int -> Int
forall a. Num a => a -> a -> a
+1) [a]
ls [a]
xs [a]
ys
mkdiff boring :: [a] -> Bool
boring ny :: Int
ny (l :: a
l:ls :: [a]
ls) xs :: [a]
xs ys :: [a]
ys
| [a]
rmd [a] -> [a] -> Bool
forall a. Eq a => a -> a -> Bool
== [a]
add = ([a] -> Bool) -> Int -> [a] -> [a] -> [a] -> [(Int, [a], [a])]
forall a.
Ord a =>
([a] -> Bool) -> Int -> [a] -> [a] -> [a] -> [(Int, [a], [a])]
mkdiff [a] -> Bool
boring (Int
nyInt -> Int -> Int
forall a. Num a => a -> a -> a
+[a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [a]
addInt -> Int -> Int
forall a. Num a => a -> a -> a
+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
[] -> Int -> [a] -> [a] -> [(Int, [a], [a])]
forall a. Ord a => Int -> [a] -> [a] -> [(Int, [a], [a])]
prefixPostfixDiff Int
ny [a]
rmd [a]
add [(Int, [a], [a])] -> [(Int, [a], [a])] -> [(Int, [a], [a])]
forall a. [a] -> [a] -> [a]
++
([a] -> Bool) -> Int -> [a] -> [a] -> [a] -> [(Int, [a], [a])]
forall a.
Ord a =>
([a] -> Bool) -> Int -> [a] -> [a] -> [a] -> [(Int, [a], [a])]
mkdiff [a] -> Bool
boring (Int
nyInt -> Int -> Int
forall a. Num a => a -> a -> a
+[a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [a]
addInt -> Int -> Int
forall a. Num a => a -> a -> a
+1) [a]
ls [a]
restx [a]
resty
ll :: [a]
ll -> ([a] -> Bool) -> Int -> [a] -> [a] -> [a] -> [(Int, [a], [a])]
forall a.
Ord a =>
([a] -> Bool) -> Int -> [a] -> [a] -> [a] -> [(Int, [a], [a])]
mkdiff (Bool -> [a] -> Bool
forall a b. a -> b -> a
const Bool
False) Int
ny [a]
ll [a]
rmd [a]
add [(Int, [a], [a])] -> [(Int, [a], [a])] -> [(Int, [a], [a])]
forall a. [a] -> [a] -> [a]
++
([a] -> Bool) -> Int -> [a] -> [a] -> [a] -> [(Int, [a], [a])]
forall a.
Ord a =>
([a] -> Bool) -> Int -> [a] -> [a] -> [a] -> [(Int, [a], [a])]
mkdiff [a] -> Bool
boring (Int
nyInt -> Int -> Int
forall a. Num a => a -> a -> a
+[a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [a]
addInt -> Int -> Int
forall a. Num a => a -> a -> a
+1) [a]
ls [a]
restx [a]
resty
| Bool
otherwise = Int -> [a] -> [a] -> [(Int, [a], [a])]
forall a. Ord a => Int -> [a] -> [a] -> [(Int, [a], [a])]
prefixPostfixDiff Int
ny [a]
rmd [a]
add [(Int, [a], [a])] -> [(Int, [a], [a])] -> [(Int, [a], [a])]
forall a. [a] -> [a] -> [a]
++
([a] -> Bool) -> Int -> [a] -> [a] -> [a] -> [(Int, [a], [a])]
forall a.
Ord a =>
([a] -> Bool) -> Int -> [a] -> [a] -> [a] -> [(Int, [a], [a])]
mkdiff [a] -> Bool
boring (Int
nyInt -> Int -> Int
forall a. Num a => a -> a -> a
+[a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [a]
addInt -> Int -> Int
forall a. Num a => a -> a -> a
+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 = Int -> [a] -> [a]
forall a. Int -> [a] -> [a]
drop ([a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [a]
rmd Int -> Int -> Int
forall a. Num a => a -> a -> a
+ 1) [a]
xs
resty :: [a]
resty = Int -> [a] -> [a]
forall a. Int -> [a] -> [a]
drop ([a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [a]
add Int -> Int -> Int
forall a. Num a => a -> a -> a
+ 1) [a]
ys
mkdiff _ _ [] [] [] = []
mkdiff boring :: [a] -> Bool
boring ny :: Int
ny [] rmd :: [a]
rmd add :: [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
[] -> Int -> [a] -> [a] -> [(Int, [a], [a])]
forall a. Ord a => Int -> [a] -> [a] -> [(Int, [a], [a])]
prefixPostfixDiff Int
ny [a]
rmd [a]
add
ll :: [a]
ll -> ([a] -> Bool) -> Int -> [a] -> [a] -> [a] -> [(Int, [a], [a])]
forall a.
Ord a =>
([a] -> Bool) -> Int -> [a] -> [a] -> [a] -> [(Int, [a], [a])]
mkdiff (Bool -> [a] -> Bool
forall a b. a -> b -> a
const Bool
False) Int
ny [a]
ll [a]
rmd [a]
add
| Bool
otherwise = Int -> [a] -> [a] -> [(Int, [a], [a])]
forall a. Ord a => Int -> [a] -> [a] -> [(Int, [a], [a])]
prefixPostfixDiff Int
ny [a]
rmd [a]
add
prefixPostfixDiff :: Ord a => Int -> [a] -> [a] -> [(Int,[a],[a])]
prefixPostfixDiff :: Int -> [a] -> [a] -> [(Int, [a], [a])]
prefixPostfixDiff _ [] [] = []
prefixPostfixDiff ny :: Int
ny [] ys :: [a]
ys = [(Int
ny,[],[a]
ys)]
prefixPostfixDiff ny :: Int
ny xs :: [a]
xs [] = [(Int
ny,[a]
xs,[])]
prefixPostfixDiff ny :: Int
ny (x :: a
x:xs :: [a]
xs) (y :: a
y:ys :: [a]
ys)
| a
x a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
y = Int -> [a] -> [a] -> [(Int, [a], [a])]
forall a. Ord a => Int -> [a] -> [a] -> [(Int, [a], [a])]
prefixPostfixDiff (Int
nyInt -> Int -> Int
forall a. Num a => a -> a -> a
+1) [a]
xs [a]
ys
| Bool
otherwise = [(Int
ny, [a] -> [a]
forall a. [a] -> [a]
reverse [a]
rxs', [a] -> [a]
forall a. [a] -> [a]
reverse [a]
rys')]
where (rxs' :: [a]
rxs',rys' :: [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]
as) (b :: a
b:bs :: [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 as :: [a]
as bs :: [a]
bs = ([a]
as,[a]
bs)
{-# SPECIALIZE patientLcs ::[Hunk] -> [Hunk] -> [Hunk] #-}
patientLcs :: Ord a => [a] -> [a] -> [a]
patientLcs :: [a] -> [a] -> [a]
patientLcs [] _ = []
patientLcs _ [] = []
patientLcs (c1 :: a
c1:c1s :: [a]
c1s) (c2 :: a
c2:c2s :: [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 :: [a] -> [a] -> [a]
patientLcs0 xs0 :: [a]
xs0@(cc1 :: a
cc1:cc1s :: [a]
cc1s) ys0 :: [a]
ys0@(cc2 :: a
cc2:cc2s :: [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]
forall a. Ord a => [a] -> [a] -> [a]
lcs [a]
xs0 [a]
ys0
(_,[]) -> [a] -> [a] -> [a]
forall a. Ord a => [a] -> [a] -> [a]
lcs [a]
xs0 [a]
ys0
(xs' :: [a]
xs',ys' :: [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 [] x :: [a]
x y :: [a]
y = [a] -> [a] -> [a]
forall a. Ord a => [a] -> [a] -> [a]
lcs [a]
x [a]
y
joinU (b :: a
b:bs :: [a]
bs) cs :: [a]
cs ds :: [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
([],_:c2 :: [a]
c2) -> a
b a -> [a] -> [a]
forall a. a -> [a] -> [a]
: [a] -> [a] -> [a] -> [a]
joinU [a]
bs [a]
c2 (Int -> [a] -> [a]
forall a. Int -> [a] -> [a]
drop 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)
(c1 :: [a]
c1,_:c2 :: [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
([],_:d2 :: [a]
d2) -> a
b a -> [a] -> [a]
forall a. a -> [a] -> [a]
: [a] -> [a] -> [a] -> [a]
joinU [a]
bs [a]
c2 [a]
d2
(d1 :: [a]
d1,_:d2 :: [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]
forall a. a
impossible
_ -> [a]
forall a. a
impossible
findUnique :: [a] -> Set a
findUnique xs :: [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 (x :: a
x:x' :: a
x':xs :: [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 (x :: a
x:xs :: [a]
xs) = a
x a -> [a] -> [a]
forall a. a -> [a] -> [a]
: [a] -> [a]
gru [a]
xs
gru [] = []
patientLcs0 [] _ = []
patientLcs0 _ [] = []
{-# SPECIALIZE lcs ::[Hunk] -> [Hunk] -> [Hunk] #-}
lcs :: Ord a => [a] -> [a] -> [a]
lcs :: [a] -> [a] -> [a]
lcs [] _ = []
lcs _ [] = []
lcs (c1 :: a
c1:c1s :: [a]
c1s) (c2 :: a
c2:c2s :: [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 :: [a] -> [a] -> [a]
lcsSimple [] _ = []
lcsSimple _ [] = []
lcsSimple s1 :: [a]
s1@(c1 :: a
c1:c1s :: [a]
c1s) s2 :: [a]
s2@(c2 :: a
c2:c2s :: [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, [Int])] -> [a]
forall a. [(a, [Int])] -> [a]
hunt ([(a, [Int])] -> [a]) -> [(a, [Int])] -> [a]
forall a b. (a -> b) -> a -> b
$ [a] -> [[Int]] -> [(a, [Int])]
forall a. [a] -> [[Int]] -> [(a, [Int])]
pruneMatches [a]
s1 ([[Int]] -> [(a, [Int])]) -> [[Int]] -> [(a, [Int])]
forall a b. (a -> b) -> a -> b
$! [a] -> [a] -> [[Int]]
forall a. Ord a => [a] -> [a] -> [[Int]]
findMatches [a]
s1 [a]
s2
pruneMatches :: [a] -> [[Int]] -> [(a, [Int])]
pruneMatches :: [a] -> [[Int]] -> [(a, [Int])]
pruneMatches _ [] = []
pruneMatches [] _ = []
pruneMatches (_:cs :: [a]
cs) ([]:ms :: [[Int]]
ms) = [a] -> [[Int]] -> [(a, [Int])]
forall a. [a] -> [[Int]] -> [(a, [Int])]
pruneMatches [a]
cs [[Int]]
ms
pruneMatches (c :: a
c:cs :: [a]
cs) (m :: [Int]
m:ms :: [[Int]]
ms) = (a
c,[Int]
m)(a, [Int]) -> [(a, [Int])] -> [(a, [Int])]
forall a. a -> [a] -> [a]
: [a] -> [[Int]] -> [(a, [Int])]
forall a. [a] -> [[Int]] -> [(a, [Int])]
pruneMatches [a]
cs [[Int]]
ms
type Threshold s a = STArray s Int (Int,[a])
hunt :: [(a, [Int])] -> [a]
hunt :: [(a, [Int])] -> [a]
hunt [] = []
hunt csmatches :: [(a, [Int])]
csmatches =
(forall s. ST s [a]) -> [a]
forall a. (forall s. ST s a) -> a
runST ( do Threshold s a
th <- Int -> Int -> ST s (Threshold s a)
forall s a. Int -> Int -> ST s (Threshold s a)
emptyThreshold ([(a, [Int])] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [(a, [Int])]
csmatches) Int
l
[(a, [Int])] -> Threshold s a -> ST s ()
forall a s. [(a, [Int])] -> Threshold s a -> ST s ()
huntInternal [(a, [Int])]
csmatches Threshold s a
th
Threshold s a -> Int -> Int -> ST s [a]
forall s a. Threshold s a -> Int -> Int -> ST s [a]
huntRecover Threshold s a
th (-1) Int
l )
where l :: Int
l = [Int] -> Int
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum (0 Int -> [Int] -> [Int]
forall a. a -> [a] -> [a]
: [[Int]] -> [Int]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat (((a, [Int]) -> [Int]) -> [(a, [Int])] -> [[Int]]
forall a b. (a -> b) -> [a] -> [b]
map (a, [Int]) -> [Int]
forall a b. (a, b) -> b
snd [(a, [Int])]
csmatches))
huntInternal :: [(a, [Int])] -> Threshold s a -> ST s ()
huntInternal :: [(a, [Int])] -> Threshold s a -> ST s ()
huntInternal [] _ = () -> ST s ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
huntInternal ((c :: a
c,m :: [Int]
m):csms :: [(a, [Int])]
csms) th :: Threshold s a
th = do
a -> [Int] -> Threshold s a -> ST s ()
forall a s. a -> [Int] -> Threshold s a -> ST s ()
huntOneChar a
c [Int]
m Threshold s a
th
[(a, [Int])] -> Threshold s a -> ST s ()
forall a s. [(a, [Int])] -> Threshold s a -> ST s ()
huntInternal [(a, [Int])]
csms Threshold s a
th
huntOneChar :: a -> [Int] -> Threshold s a -> ST s ()
huntOneChar :: a -> [Int] -> Threshold s a -> ST s ()
huntOneChar _ [] _ = () -> ST s ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
huntOneChar c :: a
c (j :: Int
j:js :: [Int]
js) th :: Threshold s a
th = do
Maybe Int
index_k <- Int -> Threshold s a -> ST s (Maybe Int)
forall s a. Int -> Threshold s a -> ST s (Maybe Int)
myBs Int
j Threshold s a
th
case Maybe Int
index_k of
Nothing -> () -> ST s ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
Just k :: Int
k -> do
(_, rest :: [a]
rest) <- Threshold s a -> Int -> ST s (Int, [a])
forall (a :: * -> * -> *) e (m :: * -> *) i.
(MArray a e m, Ix i) =>
a i e -> i -> m e
readArray Threshold s a
th (Int
kInt -> Int -> Int
forall a. Num a => a -> a -> a
-1)
Threshold s a -> Int -> (Int, [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 Int
k (Int
j, a
ca -> [a] -> [a]
forall a. a -> [a] -> [a]
:[a]
rest)
a -> [Int] -> Threshold s a -> ST s ()
forall a s. a -> [Int] -> Threshold s a -> ST s ()
huntOneChar a
c [Int]
js Threshold s a
th
huntRecover :: Threshold s a -> Int -> Int -> ST s [a]
huntRecover :: Threshold s a -> Int -> Int -> ST s [a]
huntRecover th :: Threshold s a
th n :: Int
n limit :: Int
limit =
do (_, th_max :: Int
th_max) <- Threshold s a -> ST s (Int, Int)
forall (a :: * -> * -> *) e (m :: * -> *) i.
(MArray a e m, Ix i) =>
a i e -> m (i, i)
getBounds Threshold s a
th
if Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< 0
then Threshold s a -> Int -> Int -> ST s [a]
forall s a. Threshold s a -> Int -> Int -> ST s [a]
huntRecover Threshold s a
th Int
th_max Int
limit
else if Int
n Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== 0 Bool -> Bool -> Bool
|| Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
th_max
then [a] -> ST s [a]
forall (m :: * -> *) a. Monad m => a -> m a
return []
else do (thn :: Int
thn, sn :: [a]
sn) <- Threshold s a -> Int -> ST s (Int, [a])
forall (a :: * -> * -> *) e (m :: * -> *) i.
(MArray a e m, Ix i) =>
a i e -> i -> m e
readArray Threshold s a
th Int
n
if Int
thn Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
limit
then [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 -> Int -> Int -> ST s [a]
forall s a. Threshold s a -> Int -> Int -> ST s [a]
huntRecover Threshold s a
th (Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
-1) Int
limit
emptyThreshold :: Int -> Int -> ST s (Threshold s a)
emptyThreshold :: Int -> Int -> ST s (Threshold s a)
emptyThreshold l :: Int
l th_max :: Int
th_max = do
Threshold s a
th <- (Int, Int) -> (Int, [a]) -> ST s (Threshold s a)
forall (a :: * -> * -> *) e (m :: * -> *) i.
(MArray a e m, Ix i) =>
(i, i) -> e -> m (a i e)
newArray (0,Int
l) (Int
th_maxInt -> Int -> Int
forall a. Num a => a -> a -> a
+1, [])
Threshold s a -> Int -> (Int, [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 0 (0, [])
Threshold s a -> ST s (Threshold 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 :: Int -> Threshold s a -> ST s (Maybe Int)
myBs j :: Int
j th :: Threshold s a
th = do (Int, Int)
bnds <- Threshold s a -> ST s (Int, Int)
forall (a :: * -> * -> *) e (m :: * -> *) i.
(MArray a e m, Ix i) =>
a i e -> m (i, i)
getBounds Threshold s a
th
Int -> (Int, Int) -> Threshold s a -> ST s (Maybe Int)
forall s a. Int -> (Int, Int) -> Threshold s a -> ST s (Maybe Int)
myHelperBs Int
j (Int, Int)
bnds Threshold s a
th
myHelperBs :: Int -> (Int,Int) -> Threshold s a ->
ST s (Maybe Int)
myHelperBs :: Int -> (Int, Int) -> Threshold s a -> ST s (Maybe Int)
myHelperBs j :: Int
j (th_min :: Int
th_min,th_max :: Int
th_max) th :: Threshold s a
th =
if Int
th_max Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
th_min Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> 1 then do
(midth :: Int
midth, _) <- Threshold s a -> Int -> ST s (Int, [a])
forall (a :: * -> * -> *) e (m :: * -> *) i.
(MArray a e m, Ix i) =>
a i e -> i -> m e
readArray Threshold s a
th Int
th_middle
if Int
j Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
midth
then Int -> (Int, Int) -> Threshold s a -> ST s (Maybe Int)
forall s a. Int -> (Int, Int) -> Threshold s a -> ST s (Maybe Int)
myHelperBs Int
j (Int
th_middle,Int
th_max) Threshold s a
th
else Int -> (Int, Int) -> Threshold s a -> ST s (Maybe Int)
forall s a. Int -> (Int, Int) -> Threshold s a -> ST s (Maybe Int)
myHelperBs Int
j (Int
th_min,Int
th_middle) Threshold s a
th
else do
(minth :: Int
minth, _) <- Threshold s a -> Int -> ST s (Int, [a])
forall (a :: * -> * -> *) e (m :: * -> *) i.
(MArray a e m, Ix i) =>
a i e -> i -> m e
readArray Threshold s a
th Int
th_min
(maxth :: Int
maxth, _) <- Threshold s a -> Int -> ST s (Int, [a])
forall (a :: * -> * -> *) e (m :: * -> *) i.
(MArray a e m, Ix i) =>
a i e -> i -> m e
readArray Threshold s a
th Int
th_max
if Int
minth Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
j Bool -> Bool -> Bool
&& Int
maxth Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
j
then Maybe Int -> ST s (Maybe Int)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe Int -> ST s (Maybe Int)) -> Maybe Int -> ST s (Maybe Int)
forall a b. (a -> b) -> a -> b
$ Int -> Maybe Int
forall a. a -> Maybe a
Just Int
th_max
else if Int
j Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
minth then Maybe Int -> ST s (Maybe Int)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe Int -> ST s (Maybe Int)) -> Maybe Int -> ST s (Maybe Int)
forall a b. (a -> b) -> a -> b
$ Int -> Maybe Int
forall a. a -> Maybe a
Just Int
th_min
else Maybe Int -> ST s (Maybe Int)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Int
forall a. Maybe a
Nothing
where th_middle :: Int
th_middle = (Int
th_maxInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
th_min) Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` 2
findMatches :: Ord a => [a] -> [a] -> [[Int]]
findMatches :: [a] -> [a] -> [[Int]]
findMatches [] [] = []
findMatches [] (_:bs :: [a]
bs) = [][Int] -> [[Int]] -> [[Int]]
forall a. a -> [a] -> [a]
: [a] -> [a] -> [[Int]]
forall a. Ord a => [a] -> [a] -> [[Int]]
findMatches [] [a]
bs
findMatches _ [] = []
findMatches a :: [a]
a b :: [a]
b =
[(Int, [Int])] -> [[Int]]
forall a. [(Int, [a])] -> [[a]]
unzipIndexed ([(Int, [Int])] -> [[Int]]) -> [(Int, [Int])] -> [[Int]]
forall a b. (a -> b) -> a -> b
$ [(Int, [Int])] -> [(Int, [Int])]
forall a. Ord a => [a] -> [a]
sort ([(Int, [Int])] -> [(Int, [Int])])
-> [(Int, [Int])] -> [(Int, [Int])]
forall a b. (a -> b) -> a -> b
$ [(a, Int)] -> [(a, Int)] -> [a] -> [Int] -> [(Int, [Int])]
forall a.
Ord a =>
[(a, Int)] -> [(a, Int)] -> [a] -> [Int] -> [(Int, [Int])]
findSortedMatches [(a, Int)]
indexeda [(a, Int)]
indexedb [] []
where indexeda :: [(a, Int)]
indexeda = [(a, Int)] -> [(a, Int)]
forall a. Ord a => [a] -> [a]
sort ([(a, Int)] -> [(a, Int)]) -> [(a, Int)] -> [(a, Int)]
forall a b. (a -> b) -> a -> b
$ [a] -> [Int] -> [(a, Int)]
forall a b. [a] -> [b] -> [(a, b)]
zip [a]
a [1..]
indexedb :: [(a, Int)]
indexedb = [(a, Int)] -> [(a, Int)]
forall a. Ord a => [a] -> [a]
sort ([(a, Int)] -> [(a, Int)]) -> [(a, Int)] -> [(a, Int)]
forall a b. (a -> b) -> a -> b
$ [a] -> [Int] -> [(a, Int)]
forall a b. [a] -> [b] -> [(a, b)]
zip [a]
b [1..]
unzipIndexed :: [(Int,[a])] -> [[a]]
unzipIndexed :: [(Int, [a])] -> [[a]]
unzipIndexed s :: [(Int, [a])]
s = Int -> [(Int, [a])] -> [[a]]
forall a a. (Eq a, Num a) => a -> [(a, [a])] -> [[a]]
unzipIndexedHelper 1 [(Int, [a])]
s
where unzipIndexedHelper :: a -> [(a, [a])] -> [[a]]
unzipIndexedHelper _ [] = []
unzipIndexedHelper thisl :: a
thisl ((l :: a
l,c :: [a]
c):rest :: [(a, [a])]
rest)
| a
thisl a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
l = [a]
c[a] -> [[a]] -> [[a]]
forall a. a -> [a] -> [a]
: a -> [(a, [a])] -> [[a]]
unzipIndexedHelper (a
la -> a -> a
forall a. Num a => a -> a -> a
+1) [(a, [a])]
rest
| Bool
otherwise = [][a] -> [[a]] -> [[a]]
forall a. a -> [a] -> [a]
: a -> [(a, [a])] -> [[a]]
unzipIndexedHelper (a
thisla -> a -> a
forall a. Num a => a -> a -> a
+1) ((a
l,[a]
c)(a, [a]) -> [(a, [a])] -> [(a, [a])]
forall a. a -> [a] -> [a]
:[(a, [a])]
rest)
findSortedMatches :: Ord a => [(a, Int)] -> [(a, Int)] -> [a] -> [Int]
-> [(Int, [Int])]
findSortedMatches :: [(a, Int)] -> [(a, Int)] -> [a] -> [Int] -> [(Int, [Int])]
findSortedMatches [] _ _ _ = []
findSortedMatches _ [] _ _ = []
findSortedMatches ((a :: a
a,na :: Int
na):as :: [(a, Int)]
as) ((b :: a
b,nb :: Int
nb):bs :: [(a, Int)]
bs) aold :: [a]
aold aoldmatches :: [Int]
aoldmatches
| [a
a] [a] -> [a] -> Bool
forall a. Eq a => a -> a -> Bool
== [a]
aold = (Int
na, [Int]
aoldmatches) (Int, [Int]) -> [(Int, [Int])] -> [(Int, [Int])]
forall a. a -> [a] -> [a]
:
[(a, Int)] -> [(a, Int)] -> [a] -> [Int] -> [(Int, [Int])]
forall a.
Ord a =>
[(a, Int)] -> [(a, Int)] -> [a] -> [Int] -> [(Int, [Int])]
findSortedMatches [(a, Int)]
as ((a
b,Int
nb)(a, Int) -> [(a, Int)] -> [(a, Int)]
forall a. a -> [a] -> [a]
:[(a, Int)]
bs) [a]
aold [Int]
aoldmatches
| a
a a -> a -> Bool
forall a. Ord a => a -> a -> Bool
> a
b = [(a, Int)] -> [(a, Int)] -> [a] -> [Int] -> [(Int, [Int])]
forall a.
Ord a =>
[(a, Int)] -> [(a, Int)] -> [a] -> [Int] -> [(Int, [Int])]
findSortedMatches ((a
a,Int
na)(a, Int) -> [(a, Int)] -> [(a, Int)]
forall a. a -> [a] -> [a]
:[(a, Int)]
as) [(a, Int)]
bs [a]
aold [Int]
aoldmatches
| a
a a -> a -> Bool
forall a. Ord a => a -> a -> Bool
< a
b = [(a, Int)] -> [(a, Int)] -> [a] -> [Int] -> [(Int, [Int])]
forall a.
Ord a =>
[(a, Int)] -> [(a, Int)] -> [a] -> [Int] -> [(Int, [Int])]
findSortedMatches [(a, Int)]
as ((a
b,Int
nb)(a, Int) -> [(a, Int)] -> [(a, Int)]
forall a. a -> [a] -> [a]
:[(a, Int)]
bs) [a]
aold [Int]
aoldmatches
findSortedMatches ((a :: a
a,na :: Int
na):as :: [(a, Int)]
as) bs :: [(a, Int)]
bs _ _
= (Int
na, [Int]
matches) (Int, [Int]) -> [(Int, [Int])] -> [(Int, [Int])]
forall a. a -> [a] -> [a]
: [(a, Int)] -> [(a, Int)] -> [a] -> [Int] -> [(Int, [Int])]
forall a.
Ord a =>
[(a, Int)] -> [(a, Int)] -> [a] -> [Int] -> [(Int, [Int])]
findSortedMatches [(a, Int)]
as [(a, Int)]
bs [a
a] [Int]
matches
where matches :: [Int]
matches = [Int] -> [Int]
forall a. [a] -> [a]
reverse ([Int] -> [Int]) -> [Int] -> [Int]
forall a b. (a -> b) -> a -> b
$ ((a, Int) -> Int) -> [(a, Int)] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map (a, Int) -> Int
forall a b. (a, b) -> b
snd ([(a, Int)] -> [Int]) -> [(a, Int)] -> [Int]
forall a b. (a -> b) -> a -> b
$ ((a, Int) -> Bool) -> [(a, Int)] -> [(a, Int)]
forall a. (a -> Bool) -> [a] -> [a]
filter ((a -> a -> Bool
forall a. Eq a => a -> a -> Bool
==a
a) (a -> Bool) -> ((a, Int) -> a) -> (a, Int) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a, Int) -> a
forall a b. (a, b) -> a
fst) [(a, Int)]
bs