--  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.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 Int
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 [ByteString]
a [ByteString]
b = PArray -> PArray -> Int -> [(Int, [ByteString], [ByteString])]
dropStart ([ByteString] -> PArray
initP [ByteString]
a) ([ByteString] -> PArray
initP [ByteString]
b) Int
1

dropStart ::  PArray -> PArray -> Int
           -> [(Int,[B.ByteString],[B.ByteString])]
dropStart :: PArray -> PArray -> Int -> [(Int, [ByteString], [ByteString])]
dropStart PArray
a PArray
b 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
- Int
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
- Int
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
+ Int
1)
  | Bool
otherwise      = PArray
-> PArray -> Int -> Int -> [(Int, [ByteString], [ByteString])]
dropEnd PArray
a PArray
b Int
off Int
0

dropEnd ::  PArray -> PArray -> Int -> Int
        -> [(Int,[B.ByteString],[B.ByteString])]
dropEnd :: PArray
-> PArray -> Int -> Int -> [(Int, [ByteString], [ByteString])]
dropEnd PArray
a PArray
b Int
off 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
- Int
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
- Int
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
+ Int
1)
    | Bool
otherwise          = Int
-> [ByteString]
-> [ByteString]
-> [(Int, [ByteString], [ByteString])]
getChanges' (Int
offInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
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 -- don't drop Borings just in case. See hidden_conflict2.sh
        addBorings :: Int -> Int
addBorings Int
e | Int
e Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
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
-Int
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
-Int
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' Int
off [ByteString]
o [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
              ([Int]
_,HunkMap
m') = [ByteString] -> HunkMap -> ([Int], HunkMap)
listToHunk [ByteString]
borings' HunkMap
empty
              ([Int]
oh,HunkMap
m) = [ByteString] -> HunkMap -> ([Int], HunkMap)
listToHunk [ByteString]
o HunkMap
m'
              ([Int]
nh,HunkMap
lmap) = [ByteString] -> HunkMap -> ([Int], HunkMap)
listToHunk [ByteString]
n HunkMap
m
              convertLBS :: [(a, [ByteString], [ByteString])]
-> [(a, [Int], [Int])] -> [(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,[Int]
os,[Int]
ns):[(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 [Int]
hs = (Int -> ByteString) -> [Int] -> [ByteString]
forall a b. (a -> b) -> [a] -> [b]
map (\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 Int
_ HMap Int [(Int, ByteString)]
m) = HMap Int [(Int, ByteString)]
m

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

getBArray :: HunkMap -> Array Hunk B.ByteString
getBArray :: HunkMap -> PArray
getBArray (HunkMapInfo Int
size 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 (Int
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 (\(Int
x,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 Int
h ByteString
bs 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 (\[(Int, ByteString)]
_ [(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 -- used by bylines
                                         else Int
newsize
            newsize :: Int
newsize = HunkMap -> Int
getSize HunkMap
hmapInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
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 -> (Int, HunkMap)
toHunk' HunkMap
lmap 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 [] HunkMap
hmap = ([], HunkMap
hmap)
listToHunk (ByteString
x:[ByteString]
xs) HunkMap
hmap = let (Int
y, HunkMap
hmap') = HunkMap -> ByteString -> (Int, HunkMap)
toHunk' HunkMap
hmap ByteString
x
                             ([Int]
ys, 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'')

--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 :: [[Int] -> [[Int]]]
-> Int -> [Int] -> [Int] -> [(Int, [Int], [Int])]
genNestedChanges ([Int] -> [[Int]]
br:[[Int] -> [[Int]]]
brs) Int
i0 [Int]
o0 [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 Int
i [] [[Int]]
o [[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 Int
i ([Int]
x:[[Int]]
xs) [[Int]]
o [[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
                ([[Int]]
oa, [Int]
_:[[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
                      ([[Int]]
na, [Int]
_:[[Int]]
nb) ->
                         Int
i' Int -> [(Int, [Int], [Int])] -> [(Int, [Int], [Int])]
`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]]
_,[]) -> [Char] -> [(Int, [Int], [Int])]
forall a. HasCallStack => [Char] -> a
error [Char]
"impossible case"
                ([[Int]]
_,[]) -> [Char] -> [(Int, [Int], [Int])]
forall a. HasCallStack => [Char] -> a
error [Char]
"impossible case"
          easydiff :: Int -> t [Int] -> t [Int] -> [(Int, [Int], [Int])]
easydiff Int
i t [Int]
o t [Int]
n = [[Int] -> [[Int]]]
-> Int -> [Int] -> [Int] -> [(Int, [Int], [Int])]
genNestedChanges [[Int] -> [[Int]]]
brs Int
i [Int]
oo [Int]
nn
              where ([Int]
oo, [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 [] Int
i [Int]
o [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' = ([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 :: [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 [[Int]]
xs [] = [[Int]]
xs
          byparagraphAcc [] (Int
a:Int
b:Int
c:[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] -> [[Int]]
byparagraphAcc [[],[Int
c,Int
b,Int
a]] [Int]
d
          byparagraphAcc [] (Int
a:[Int]
as) = [[Int]] -> [Int] -> [[Int]]
byparagraphAcc [[Int
a]] [Int]
as
          byparagraphAcc ([Int]
x:[[Int]]
xs) (Int
a:Int
b:Int
c:[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] -> [[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 ([Int]
x:[[Int]]
xs) (Int
a:[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 = -Int
1 -- "\n" hunk
          hnull :: Int
hnull = Int
1 -- "" hunk toHunk $ BC.pack ""

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 [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 :: [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 :: ([a] -> Bool) -> Int -> [a] -> [a] -> [a] -> [(Int, [a], [a])]
mkdiff [a] -> Bool
b Int
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) -> 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
+Int
1) [a]
ls [a]
xs [a]
ys
mkdiff [a] -> Bool
boring Int
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) -> 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
+Int
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
+Int
1) [a]
ls [a]
restx [a]
resty
        [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
+Int
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
+Int
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
+ Int
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
+ Int
1) [a]
ys
mkdiff [a] -> Bool
_ Int
_ [] [] [] = []
mkdiff [a] -> Bool
boring Int
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
        [] -> Int -> [a] -> [a] -> [(Int, [a], [a])]
forall a. Ord a => Int -> [a] -> [a] -> [(Int, [a], [a])]
prefixPostfixDiff Int
ny [a]
rmd [a]
add
        [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 Int
_ [] [] = []
prefixPostfixDiff Int
ny [] [a]
ys = [(Int
ny,[],[a]
ys)]
prefixPostfixDiff Int
ny [a]
xs [] = [(Int
ny,[a]
xs,[])]
prefixPostfixDiff Int
ny (a
x:[a]
xs) (a
y:[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
+Int
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 ([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 :: [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 :: [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 (Int -> [a] -> [a]
forall a. Int -> [a] -> [a]
drop Int
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 :: [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 :: [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, [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 [a]
_ [] = []
pruneMatches [] [[Int]]
_ = []
pruneMatches (a
_:[a]
cs) ([]:[[Int]]
ms) = [a] -> [[Int]] -> [(a, [Int])]
forall a. [a] -> [[Int]] -> [(a, [Int])]
pruneMatches [a]
cs [[Int]]
ms
pruneMatches (a
c:[a]
cs) ([Int]
m:[[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 [(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 (-Int
1) Int
l )
    where l :: Int
l = [Int] -> Int
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum (Int
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 [] Threshold s a
_ = () -> ST s ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
huntInternal ((a
c,[Int]
m):[(a, [Int])]
csms) 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 a
_ [] Threshold s a
_ = () -> ST s ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
huntOneChar a
c (Int
j:[Int]
js) 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
      Maybe Int
Nothing -> () -> ST s ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
      Just Int
k -> do
        (Int
_, [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
-Int
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

-- This is O(n), which is stupid.
huntRecover :: Threshold s a -> Int -> Int -> ST s [a]
huntRecover :: Threshold s a -> Int -> Int -> ST s [a]
huntRecover Threshold s a
th Int
n Int
limit =
 do (Int
_, 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
< Int
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
== Int
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 (Int
thn, [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
-Int
1) Int
limit

emptyThreshold :: Int -> Int -> ST s (Threshold s a)
emptyThreshold :: Int -> Int -> ST s (Threshold s a)
emptyThreshold Int
l 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 (Int
0,Int
l) (Int
th_maxInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
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
0 (Int
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 Int
j 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 Int
j (Int
th_min,Int
th_max) 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
> Int
1 then do
       (Int
midth, [a]
_) <- 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
       (Int
minth, [a]
_) <- 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
       (Int
maxth, [a]
_) <- 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` Int
2



findMatches :: Ord a => [a] -> [a] -> [[Int]]
findMatches :: [a] -> [a] -> [[Int]]
findMatches [] [] = []
findMatches [] (a
_:[a]
bs) = [][Int] -> [[Int]] -> [[Int]]
forall a. a -> [a] -> [a]
: [a] -> [a] -> [[Int]]
forall a. Ord a => [a] -> [a] -> [[Int]]
findMatches [] [a]
bs
findMatches [a]
_ [] = []
findMatches [a]
a [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 [Int
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 [Int
1..]

unzipIndexed :: [(Int,[a])] -> [[a]]
unzipIndexed :: [(Int, [a])] -> [[a]]
unzipIndexed [(Int, [a])]
s = Int -> [(Int, [a])] -> [[a]]
forall a a. (Eq a, Num a) => a -> [(a, [a])] -> [[a]]
unzipIndexedHelper Int
1 [(Int, [a])]
s
    where unzipIndexedHelper :: a -> [(a, [a])] -> [[a]]
unzipIndexedHelper a
_ [] = []
          unzipIndexedHelper a
thisl ((a
l,[a]
c):[(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
+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
+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 [] [(a, Int)]
_ [a]
_ [Int]
_ = []
findSortedMatches [(a, Int)]
_ [] [a]
_ [Int]
_ = []
findSortedMatches ((a
a,Int
na):[(a, Int)]
as) ((a
b,Int
nb):[(a, Int)]
bs) [a]
aold [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
-- following line is inefficient if a line is repeated many times.
findSortedMatches ((a
a,Int
na):[(a, Int)]
as) [(a, Int)]
bs [a]
_ [Int]
_ -- a == b
      = (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