-- Copyright (C) 2002 David Roundy
-- Copyright (C) 2005 Benedikt Schmidt
--
-- 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; see the file COPYING.  If not, write to
-- the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
-- Boston, MA 02110-1301, USA.

-- |
-- Module      : Darcs.Util.Diff.Myers
-- Copyright   : 2003 David Roundy
--               2005 Benedikt Schmidt
-- License     : GPL
-- Maintainer  : darcs-devel@darcs.net
-- Stability   : experimental
-- Portability : portable
--
-- LCS stands for Longest Common Subsequence, and it is a relatively
-- challenging problem to find an LCS efficiently.  This module implements
-- the algorithm described in:
--
--   "An O(ND) Difference Algorithm and its Variations", Eugene Myers,
--   Algorithmica Vol. 1 No. 2, 1986, pp. 251-266;
--   especially the variation described in section 4.2 and most refinements
--   implemented in GNU diff (D is the edit-distance).
--
-- There is currently no heuristic to reduce the running time and produce
-- suboptimal output for large inputs with many differences. It behaves like
-- GNU diff with the -d option in this regard.
--
-- In the first step, a hash value for every line is calculated and collisions
-- are marked with a special value. This reduces a string comparison to an
-- int comparison for line tuples where at least one of the hash values is
-- not equal to the special value. After that, lines which only exists in one
-- of the files are removed and marked as changed which reduces the running
-- time of the following difference algorithm. GNU diff additionally removes
-- lines that appear very often in the other file in some cases.
-- The last step tries to create longer changed regions and line up deletions
-- in the first file to insertions in the second by shifting changed lines
-- forward and backward.

module Darcs.Util.Diff.Myers
    ( getChanges
    , shiftBoundaries
    , initP
    , aLen
    , PArray
    , getSlice
    ) where

import Darcs.Prelude

import Control.Monad
import Data.Int
import Control.Monad.ST
import Data.Maybe
import Darcs.Util.ByteString (hashPS)
import qualified Data.ByteString as B (empty, ByteString)
import Data.Array.Base
import Data.Array.Unboxed
import qualified Data.Map as Map ( lookup, empty, insertWith )

-- | create a list of changes between a and b, each change has the form
--   (starta, lima, startb, limb) which means that a[starta, lima)
--   has to be replaced by b[startb, limb)
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          = (PArray, (Int, Int))
-> (PArray, (Int, Int)) -> [(Int, [ByteString], [ByteString])]
getChanges' (PArray
a, (Int
off, Int
alast)) (PArray
b, (Int
off, Int
blast))
  where 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

getSlice :: PArray -> Int -> Int -> [B.ByteString]
getSlice :: PArray -> Int -> Int -> [ByteString]
getSlice PArray
a Int
from Int
to
  | Int
from Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
to = []
  | Bool
otherwise = (PArray
a PArray -> Int -> ByteString
forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
a i e -> i -> e
! Int
from) ByteString -> [ByteString] -> [ByteString]
forall a. a -> [a] -> [a]
: PArray -> Int -> Int -> [ByteString]
getSlice PArray
a (Int
from Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) Int
to

getChanges' :: (PArray, (Int, Int)) -> (PArray, (Int, Int))
            -> [(Int,[B.ByteString],[B.ByteString])]
getChanges' :: (PArray, (Int, Int))
-> (PArray, (Int, Int)) -> [(Int, [ByteString], [ByteString])]
getChanges' (PArray
a, (Int, Int)
abounds) (PArray
b, (Int, Int)
bbounds) =
    ((Int, Int, Int, Int) -> (Int, [ByteString], [ByteString]))
-> [(Int, Int, Int, Int)] -> [(Int, [ByteString], [ByteString])]
forall a b. (a -> b) -> [a] -> [b]
map (Int
-> PArray
-> PArray
-> (Int, Int, Int, Int)
-> (Int, [ByteString], [ByteString])
convertPatch Int
0 PArray
a PArray
b) ([(Int, Int, Int, Int)] -> [(Int, [ByteString], [ByteString])])
-> [(Int, Int, Int, Int)] -> [(Int, [ByteString], [ByteString])]
forall a b. (a -> b) -> a -> b
$ BArray -> BArray -> [(Int, Int, Int, Int)]
createPatch BArray
c_a BArray
c_b
  where
        -- If the last few characters of two lines are the same, the lines are
        -- probably the same. The choice of 20 is plucked out of the air.
        toHash :: a i ByteString -> (i, i) -> a i Int32
toHash a i ByteString
x (i, i)
bnds = (i, i) -> [Int32] -> a i Int32
forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
(i, i) -> [e] -> a i e
listArray (i, i)
bnds [ ByteString -> Int32
hashPS (ByteString -> Int32) -> ByteString -> Int32
forall a b. (a -> b) -> a -> b
$ a i ByteString
xa i ByteString -> i -> ByteString
forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
a i e -> i -> e
!i
i | i
i <- (i, i) -> [i]
forall a. Ix a => (a, a) -> [a]
range (i, i)
bnds]
        ah :: HArray
ah = PArray -> (Int, Int) -> HArray
forall i (a :: * -> * -> *) (a :: * -> * -> *).
(Ix i, IArray a Int32, IArray a ByteString) =>
a i ByteString -> (i, i) -> a i Int32
toHash PArray
a (Int, Int)
abounds :: HArray
        mkAMap :: Map Int32 (Bool, Bool, Bool, ByteString)
-> [Int] -> Map Int32 (Bool, Bool, Bool, ByteString)
mkAMap Map Int32 (Bool, Bool, Bool, ByteString)
m (Int
i:[Int]
is) =
            let ins :: (a, b, c, d) -> (Bool, b, c, d) -> (Bool, Bool, Bool, d)
ins (a
_,b
_,c
_,d
new) (Bool
collision,b
_,c
_,d
old) =
                    (Bool
collision Bool -> Bool -> Bool
|| (d
new d -> d -> Bool
forall a. Eq a => a -> a -> Bool
/= d
old), Bool
True, Bool
False, d
old)
                m' :: Map Int32 (Bool, Bool, Bool, ByteString)
m' = ((Bool, Bool, Bool, ByteString)
 -> (Bool, Bool, Bool, ByteString)
 -> (Bool, Bool, Bool, ByteString))
-> Int32
-> (Bool, Bool, Bool, ByteString)
-> Map Int32 (Bool, Bool, Bool, ByteString)
-> Map Int32 (Bool, Bool, Bool, ByteString)
forall k a. Ord k => (a -> a -> a) -> k -> a -> Map k a -> Map k a
Map.insertWith (Bool, Bool, Bool, ByteString)
-> (Bool, Bool, Bool, ByteString) -> (Bool, Bool, Bool, ByteString)
forall d a b c b c.
Eq d =>
(a, b, c, d) -> (Bool, b, c, d) -> (Bool, Bool, Bool, d)
ins (HArray
ahHArray -> Int -> Int32
forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
a i e -> i -> e
!Int
i) (Bool
False, Bool
True, Bool
False, PArray
aPArray -> Int -> ByteString
forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
a i e -> i -> e
!Int
i) Map Int32 (Bool, Bool, Bool, ByteString)
m
            in Map Int32 (Bool, Bool, Bool, ByteString)
-> [Int] -> Map Int32 (Bool, Bool, Bool, ByteString)
mkAMap Map Int32 (Bool, Bool, Bool, ByteString)
m' [Int]
is
        mkAMap Map Int32 (Bool, Bool, Bool, ByteString)
m [Int]
_ = Map Int32 (Bool, Bool, Bool, ByteString)
m
        hm_a :: Map Int32 (Bool, Bool, Bool, ByteString)
hm_a = Map Int32 (Bool, Bool, Bool, ByteString)
-> [Int] -> Map Int32 (Bool, Bool, Bool, ByteString)
mkAMap Map Int32 (Bool, Bool, Bool, ByteString)
forall k a. Map k a
Map.empty ((Int, Int) -> [Int]
forall a. Ix a => (a, a) -> [a]
range (Int, Int)
abounds)
        --
        bh :: HArray
bh = PArray -> (Int, Int) -> HArray
forall i (a :: * -> * -> *) (a :: * -> * -> *).
(Ix i, IArray a Int32, IArray a ByteString) =>
a i ByteString -> (i, i) -> a i Int32
toHash PArray
b (Int, Int)
bbounds :: HArray
        mkBMap :: Map Int32 (Bool, Bool, Bool, ByteString)
-> [Int] -> Map Int32 (Bool, Bool, Bool, ByteString)
mkBMap Map Int32 (Bool, Bool, Bool, ByteString)
m (Int
i:[Int]
is) =
            let ins :: (a, b, c, d) -> (Bool, b, c, d) -> (Bool, b, Bool, d)
ins (a
_,b
_,c
_,d
new) (Bool
collision,b
in_a,c
_,d
old) =
                    (Bool
collision Bool -> Bool -> Bool
|| (d
new d -> d -> Bool
forall a. Eq a => a -> a -> Bool
/= d
old), b
in_a, Bool
True, d
old)
                m' :: Map Int32 (Bool, Bool, Bool, ByteString)
m' = ((Bool, Bool, Bool, ByteString)
 -> (Bool, Bool, Bool, ByteString)
 -> (Bool, Bool, Bool, ByteString))
-> Int32
-> (Bool, Bool, Bool, ByteString)
-> Map Int32 (Bool, Bool, Bool, ByteString)
-> Map Int32 (Bool, Bool, Bool, ByteString)
forall k a. Ord k => (a -> a -> a) -> k -> a -> Map k a -> Map k a
Map.insertWith (Bool, Bool, Bool, ByteString)
-> (Bool, Bool, Bool, ByteString) -> (Bool, Bool, Bool, ByteString)
forall d a b c b c.
Eq d =>
(a, b, c, d) -> (Bool, b, c, d) -> (Bool, b, Bool, d)
ins (HArray
bhHArray -> Int -> Int32
forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
a i e -> i -> e
!Int
i) (Bool
False, Bool
False, Bool
True, PArray
bPArray -> Int -> ByteString
forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
a i e -> i -> e
!Int
i) Map Int32 (Bool, Bool, Bool, ByteString)
m
            in Map Int32 (Bool, Bool, Bool, ByteString)
-> [Int] -> Map Int32 (Bool, Bool, Bool, ByteString)
mkBMap Map Int32 (Bool, Bool, Bool, ByteString)
m' [Int]
is
        mkBMap Map Int32 (Bool, Bool, Bool, ByteString)
m [Int]
_ = Map Int32 (Bool, Bool, Bool, ByteString)
m
        hm :: Map Int32 (Bool, Bool, Bool, ByteString)
hm = Map Int32 (Bool, Bool, Bool, ByteString)
-> [Int] -> Map Int32 (Bool, Bool, Bool, ByteString)
mkBMap Map Int32 (Bool, Bool, Bool, ByteString)
hm_a ((Int, Int) -> [Int]
forall a. Ix a => (a, a) -> [a]
range (Int, Int)
bbounds)
        -- take care of collisions, if there are different lines with the
        -- same hash in both files, then set the hash to markColl,
        -- PackedStrings are compared for two lines with the hash markColl
        get :: (a, Int32) -> Maybe (a, Int32)
get (a
i, Int32
h) = case Int32
-> Map Int32 (Bool, Bool, Bool, ByteString)
-> Maybe (Bool, Bool, Bool, ByteString)
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Int32
h Map Int32 (Bool, Bool, Bool, ByteString)
hm of
                      Just (Bool
_,Bool
False,Bool
_,ByteString
_) -> Maybe (a, Int32)
forall a. Maybe a
Nothing
                      Just (Bool
_,Bool
_,Bool
False,ByteString
_) -> Maybe (a, Int32)
forall a. Maybe a
Nothing
                      Just (Bool
False,Bool
True,Bool
True,ByteString
_) -> (a, Int32) -> Maybe (a, Int32)
forall a. a -> Maybe a
Just (a
i, Int32
h)
                      Just (Bool
True,Bool
True,Bool
True,ByteString
_) -> (a, Int32) -> Maybe (a, Int32)
forall a. a -> Maybe a
Just (a
i, Int32
markColl)
                      Maybe (Bool, Bool, Bool, ByteString)
Nothing -> [Char] -> Maybe (a, Int32)
forall a. HasCallStack => [Char] -> a
error [Char]
"impossible case"

        a' :: [(Int, Int32)]
a' = ((Int, Int32) -> Maybe (Int, Int32))
-> [(Int, Int32)] -> [(Int, Int32)]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (Int, Int32) -> Maybe (Int, Int32)
forall a. (a, Int32) -> Maybe (a, Int32)
get [(Int
i, HArray
ahHArray -> Int -> Int32
forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
a i e -> i -> e
!Int
i) | Int
i <- (Int, Int) -> [Int]
forall a. Ix a => (a, a) -> [a]
range (HArray -> (Int, Int)
forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
a i e -> (i, i)
bounds HArray
ah)]
        b' :: [(Int, Int32)]
b' = ((Int, Int32) -> Maybe (Int, Int32))
-> [(Int, Int32)] -> [(Int, Int32)]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (Int, Int32) -> Maybe (Int, Int32)
forall a. (a, Int32) -> Maybe (a, Int32)
get [(Int
i, HArray
bhHArray -> Int -> Int32
forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
a i e -> i -> e
!Int
i) | Int
i <- (Int, Int) -> [Int]
forall a. Ix a => (a, a) -> [a]
range (HArray -> (Int, Int)
forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
a i e -> (i, i)
bounds HArray
bh)]

        (BArray
c_a, BArray
c_b) = [(Int, Int32)]
-> [(Int, Int32)]
-> (PArray, (Int, Int))
-> (PArray, (Int, Int))
-> (BArray, BArray)
diffArr [(Int, Int32)]
a' [(Int, Int32)]
b' (PArray
a, (Int, Int)
abounds) (PArray
b, (Int, Int)
bbounds)

-- | mark hash value where collision occured
markColl :: Int32
markColl :: Int32
markColl = Int32
2345677

-- | return arrays with changes in a and b (1 indexed), offsets start with 0
diffArr :: [(Int,Int32)] -> [(Int,Int32)]
        -> (PArray, (Int, Int)) -> (PArray, (Int, Int))
        -> (BArray, BArray)
diffArr :: [(Int, Int32)]
-> [(Int, Int32)]
-> (PArray, (Int, Int))
-> (PArray, (Int, Int))
-> (BArray, BArray)
diffArr [(Int, Int32)]
a [(Int, Int32)]
b (PArray
p_a, (Int
off_a, Int
l_a)) (PArray
p_b, (Int
off_b, Int
l_b)) = (forall s. ST s (BArray, BArray)) -> (BArray, BArray)
forall a. (forall s. ST s a) -> a
runST (
  do let h_a :: HArray
h_a = [Int32] -> HArray
initH (((Int, Int32) -> Int32) -> [(Int, Int32)] -> [Int32]
forall a b. (a -> b) -> [a] -> [b]
map (Int, Int32) -> Int32
forall a b. (a, b) -> b
snd [(Int, Int32)]
a)
         h_b :: HArray
h_b = [Int32] -> HArray
initH (((Int, Int32) -> Int32) -> [(Int, Int32)] -> [Int32]
forall a b. (a -> b) -> [a] -> [b]
map (Int, Int32) -> Int32
forall a b. (a, b) -> b
snd [(Int, Int32)]
b)
         m_a :: MapArray
m_a = [Int] -> MapArray
initM (((Int, Int32) -> Int) -> [(Int, Int32)] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map (Int, Int32) -> Int
forall a b. (a, b) -> a
fst [(Int, Int32)]
a)
         m_b :: MapArray
m_b = [Int] -> MapArray
initM (((Int, Int32) -> Int) -> [(Int, Int32)] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map (Int, Int32) -> Int
forall a b. (a, b) -> a
fst [(Int, Int32)]
b)
         end_a :: Int
end_a = PArray -> Int
forall (a :: * -> * -> *) e. IArray a e => a Int e -> Int
aLen PArray
p_a
         end_b :: Int
end_b = PArray -> Int
forall (a :: * -> * -> *) e. IArray a e => a Int e -> Int
aLen PArray
p_b
     BSTArray s
c_a <- Int -> ST s (BSTArray s)
forall s. Int -> ST s (BSTArray s)
initVChanged Int
end_a
     BSTArray s
c_b <- Int -> ST s (BSTArray s)
forall s. Int -> ST s (BSTArray s)
initVChanged Int
end_b
     ((Int, Int32) -> ST s ()) -> [(Int, Int32)] -> ST s ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (\ (Int
l,Int32
_) -> BSTArray s -> Int -> Bool -> ST s ()
forall (a :: * -> * -> *) e (m :: * -> *) i.
(MArray a e m, Ix i) =>
a i e -> i -> e -> m ()
writeArray BSTArray s
c_a Int
l Bool
False) [(Int, Int32)]
a
     ((Int, Int32) -> ST s ()) -> [(Int, Int32)] -> ST s ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (\ (Int
l,Int32
_) -> BSTArray s -> Int -> Bool -> ST s ()
forall (a :: * -> * -> *) e (m :: * -> *) i.
(MArray a e m, Ix i) =>
a i e -> i -> e -> m ()
writeArray BSTArray s
c_b Int
l Bool
False) [(Int, Int32)]
b
     Int
_ <- HArray
-> HArray
-> PArray
-> PArray
-> MapArray
-> MapArray
-> BSTArray s
-> BSTArray s
-> Int
-> Int
-> Int
-> Int
-> ST s Int
forall s.
HArray
-> HArray
-> PArray
-> PArray
-> MapArray
-> MapArray
-> BSTArray s
-> BSTArray s
-> Int
-> Int
-> Int
-> Int
-> ST s Int
cmpseq HArray
h_a HArray
h_b PArray
p_a PArray
p_b MapArray
m_a MapArray
m_b BSTArray s
c_a BSTArray s
c_b Int
0 Int
0 (HArray -> Int
forall (a :: * -> * -> *) e. IArray a e => a Int e -> Int
aLen HArray
h_a) (HArray -> Int
forall (a :: * -> * -> *) e. IArray a e => a Int e -> Int
aLen HArray
h_b)
     let unchanged :: a i Bool -> m Int
unchanged a i Bool
ar = do {[Bool]
xs <- a i Bool -> m [Bool]
forall (a :: * -> * -> *) e (m :: * -> *) i.
(MArray a e m, Ix i) =>
a i e -> m [e]
getElems a i Bool
ar; Int -> m Int
forall (m :: * -> *) a. Monad m => a -> m a
return (Int -> m Int) -> Int -> m Int
forall a b. (a -> b) -> a -> b
$ [Bool] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ((Bool -> Bool) -> [Bool] -> [Bool]
forall a. (a -> Bool) -> [a] -> [a]
filter Bool -> Bool
not [Bool]
xs) Int -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1}
     Bool
err <- (Int -> Int -> Bool) -> ST s Int -> ST s Int -> ST s Bool
forall (m :: * -> *) a1 a2 r.
Monad m =>
(a1 -> a2 -> r) -> m a1 -> m a2 -> m r
liftM2 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
(/=) (BSTArray s -> ST s Int
forall (m :: * -> *) (a :: * -> * -> *) i.
(MArray a Bool m, Ix i) =>
a i Bool -> m Int
unchanged BSTArray s
c_a) (BSTArray s -> ST s Int
forall (m :: * -> *) (a :: * -> * -> *) i.
(MArray a Bool m, Ix i) =>
a i Bool -> m Int
unchanged BSTArray s
c_b)
     Bool -> ST s () -> ST s ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
err (ST s () -> ST s ()) -> ST s () -> ST s ()
forall a b. (a -> b) -> a -> b
$ [Char] -> ST s ()
forall a. HasCallStack => [Char] -> a
error [Char]
"impossible case"
     -- Mark common lines at beginning and end
     (Int -> ST s ()) -> [Int] -> ST s ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (\ Int
i -> BSTArray s -> Int -> Bool -> ST s ()
forall (a :: * -> * -> *) e (m :: * -> *) i.
(MArray a e m, Ix i) =>
a i e -> i -> e -> m ()
writeArray BSTArray s
c_a Int
i Bool
False ) [Int
1..(Int
off_a Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)]
     (Int -> ST s ()) -> [Int] -> ST s ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (\ Int
i -> BSTArray s -> Int -> Bool -> ST s ()
forall (a :: * -> * -> *) e (m :: * -> *) i.
(MArray a e m, Ix i) =>
a i e -> i -> e -> m ()
writeArray BSTArray s
c_b Int
i Bool
False ) [Int
1..(Int
off_b Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)]
     (Int -> ST s ()) -> [Int] -> ST s ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (\ Int
i -> BSTArray s -> Int -> Bool -> ST s ()
forall (a :: * -> * -> *) e (m :: * -> *) i.
(MArray a e m, Ix i) =>
a i e -> i -> e -> m ()
writeArray BSTArray s
c_a Int
i Bool
False ) [(Int
l_a Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) .. Int
end_a]
     (Int -> ST s ()) -> [Int] -> ST s ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (\ Int
i -> BSTArray s -> Int -> Bool -> ST s ()
forall (a :: * -> * -> *) e (m :: * -> *) i.
(MArray a e m, Ix i) =>
a i e -> i -> e -> m ()
writeArray BSTArray s
c_b Int
i Bool
False ) [(Int
l_b Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) .. Int
end_b]
     BSTArray s -> BSTArray s -> PArray -> Int -> Int -> ST s ()
forall s.
BSTArray s -> BSTArray s -> PArray -> Int -> Int -> ST s ()
shiftBoundaries BSTArray s
c_a BSTArray s
c_b PArray
p_a Int
1 Int
1
     BSTArray s -> BSTArray s -> PArray -> Int -> Int -> ST s ()
forall s.
BSTArray s -> BSTArray s -> PArray -> Int -> Int -> ST s ()
shiftBoundaries BSTArray s
c_b BSTArray s
c_a PArray
p_b Int
1 Int
1
     Bool
err1 <- (Int -> Int -> Bool) -> ST s Int -> ST s Int -> ST s Bool
forall (m :: * -> *) a1 a2 r.
Monad m =>
(a1 -> a2 -> r) -> m a1 -> m a2 -> m r
liftM2 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
(/=) (BSTArray s -> ST s Int
forall (m :: * -> *) (a :: * -> * -> *) i.
(MArray a Bool m, Ix i) =>
a i Bool -> m Int
unchanged BSTArray s
c_a) (BSTArray s -> ST s Int
forall (m :: * -> *) (a :: * -> * -> *) i.
(MArray a Bool m, Ix i) =>
a i Bool -> m Int
unchanged BSTArray s
c_b)
     Bool -> ST s () -> ST s ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
err1 (ST s () -> ST s ()) -> ST s () -> ST s ()
forall a b. (a -> b) -> a -> b
$ [Char] -> ST s ()
forall a. HasCallStack => [Char] -> a
error [Char]
"impossible case"
     BArray
c_a' <- BSTArray s -> ST s BArray
forall i (a :: * -> * -> *) e (m :: * -> *) (b :: * -> * -> *).
(Ix i, MArray a e m, IArray b e) =>
a i e -> m (b i e)
unsafeFreeze BSTArray s
c_a
     BArray
c_b' <- BSTArray s -> ST s BArray
forall i (a :: * -> * -> *) e (m :: * -> *) (b :: * -> * -> *).
(Ix i, MArray a e m, IArray b e) =>
a i e -> m (b i e)
unsafeFreeze BSTArray s
c_b
     (BArray, BArray) -> ST s (BArray, BArray)
forall (m :: * -> *) a. Monad m => a -> m a
return (BArray
c_a', BArray
c_b'))

-- | set changes array for a and b and return number of changed lines
cmpseq :: HArray -> HArray -> PArray -> PArray -> MapArray -> MapArray
       -> BSTArray s -> BSTArray s -> Int -> Int -> Int -> Int -> ST s Int
cmpseq :: HArray
-> HArray
-> PArray
-> PArray
-> MapArray
-> MapArray
-> BSTArray s
-> BSTArray s
-> Int
-> Int
-> Int
-> Int
-> ST s Int
cmpseq HArray
_ HArray
_ PArray
_ PArray
_ MapArray
_ MapArray
_ BSTArray s
_ BSTArray s
_ Int
_ Int
_ Int
0 Int
0 = Int -> ST s Int
forall (m :: * -> *) a. Monad m => a -> m a
return Int
0
cmpseq HArray
h_a HArray
h_b PArray
p_a PArray
p_b MapArray
m_a MapArray
m_b BSTArray s
c_a BSTArray s
c_b Int
off_a Int
off_b Int
l_a Int
l_b = do
  let lim_a :: Int
lim_a = Int
off_aInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
l_a
      lim_b :: Int
lim_b = Int
off_bInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
l_b
      off_a' :: Int
off_a' = HArray
-> HArray
-> PArray
-> PArray
-> MapArray
-> MapArray
-> Int
-> Int
-> Int
-> Int
-> Int
-> Int
-> Int
findSnake HArray
h_a HArray
h_b PArray
p_a PArray
p_b MapArray
m_a MapArray
m_b Int
off_a Int
off_b Int
l_a Int
l_b Int
off_a Int
off_b
      off_b' :: Int
off_b' = Int
off_bInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
off_a'Int -> Int -> Int
forall a. Num a => a -> a -> a
-Int
off_a
      lim_a' :: Int
lim_a' = HArray
-> HArray
-> PArray
-> PArray
-> MapArray
-> MapArray
-> Int
-> Int
-> Int
-> Int
-> Int
findSnakeRev HArray
h_a HArray
h_b PArray
p_a PArray
p_b MapArray
m_a MapArray
m_b Int
lim_a Int
lim_b Int
off_a' Int
off_b'
      lim_b' :: Int
lim_b' = Int
lim_bInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
lim_a'Int -> Int -> Int
forall a. Num a => a -> a -> a
-Int
lim_a
      l_a' :: Int
l_a' = Int
lim_a'Int -> Int -> Int
forall a. Num a => a -> a -> a
-Int
off_a'
      l_b' :: Int
l_b' = Int
lim_b'Int -> Int -> Int
forall a. Num a => a -> a -> a
-Int
off_b'
  if Int
l_a' Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 Bool -> Bool -> Bool
|| Int
l_b' Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0
     then if Int
l_a' Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0
             then do Bool -> ST s () -> ST s ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
l_b' Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0) (ST s () -> ST s ()) -> ST s () -> ST s ()
forall a b. (a -> b) -> a -> b
$
                          (Int -> ST s ()) -> [Int] -> ST s ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (\Int
i -> BSTArray s -> Int -> Bool -> ST s ()
forall (a :: * -> * -> *) e (m :: * -> *) i.
(MArray a e m, Ix i) =>
a i e -> i -> e -> m ()
writeArray BSTArray s
c_b (MapArray
m_bMapArray -> Int -> Int
forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
a i e -> i -> e
!Int
i) Bool
True)
                                [(Int
off_b' Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) .. Int
lim_b']
                     Int -> ST s Int
forall (m :: * -> *) a. Monad m => a -> m a
return Int
l_b'
             else do Bool -> ST s () -> ST s ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
l_a' Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0) (ST s () -> ST s ()) -> ST s () -> ST s ()
forall a b. (a -> b) -> a -> b
$
                          (Int -> ST s ()) -> [Int] -> ST s ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (\Int
i -> BSTArray s -> Int -> Bool -> ST s ()
forall (a :: * -> * -> *) e (m :: * -> *) i.
(MArray a e m, Ix i) =>
a i e -> i -> e -> m ()
writeArray BSTArray s
c_a (MapArray
m_aMapArray -> Int -> Int
forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
a i e -> i -> e
!Int
i) Bool
True)
                                [(Int
off_a' Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) .. Int
lim_a']
                     Int -> ST s Int
forall (m :: * -> *) a. Monad m => a -> m a
return Int
l_a'
     else do let m :: Int
m = Int
l_a' Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
l_b'
                 del :: Int
del = Int
l_a' Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
l_b'
                 dodd :: Bool
dodd = Int -> Bool
forall a. Integral a => a -> Bool
odd Int
del
             VSTArray s
v <- Int -> ST s (VSTArray s)
forall s. Int -> ST s (VSTArray s)
initV Int
m
             VSTArray s
vrev <- Int -> Int -> ST s (VSTArray s)
forall s. Int -> Int -> ST s (VSTArray s)
initVRev Int
m Int
l_a'
             VSTArray s -> Int -> Int -> ST s ()
forall (a :: * -> * -> *) e (m :: * -> *) i.
(MArray a e m, Ix i) =>
a i e -> i -> e -> m ()
writeArray VSTArray s
vrev Int
0 Int
l_a'
             VSTArray s -> Int -> Int -> ST s ()
forall (a :: * -> * -> *) e (m :: * -> *) i.
(MArray a e m, Ix i) =>
a i e -> i -> e -> m ()
writeArray VSTArray s
v Int
0 Int
0
             (Int
xmid, Int
ymid, Int
_) <- Int
-> HArray
-> HArray
-> PArray
-> PArray
-> MapArray
-> MapArray
-> VSTArray s
-> VSTArray s
-> Int
-> Int
-> Int
-> Int
-> Int
-> Bool
-> ST s (Int, Int, Int)
forall s.
Int
-> HArray
-> HArray
-> PArray
-> PArray
-> MapArray
-> MapArray
-> VSTArray s
-> VSTArray s
-> Int
-> Int
-> Int
-> Int
-> Int
-> Bool
-> ST s (Int, Int, Int)
findDiag Int
1 HArray
h_a HArray
h_b PArray
p_a PArray
p_b MapArray
m_a MapArray
m_b VSTArray s
v VSTArray s
vrev
                                Int
off_a' Int
off_b' Int
l_a' Int
l_b' Int
del Bool
dodd
             Bool -> ST s () -> ST s ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when ((Int
xmid Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 Bool -> Bool -> Bool
&& Int
ymid Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0) Bool -> Bool -> Bool
|| (Int
xmid Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
l_a' Bool -> Bool -> Bool
&& Int
ymid Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
l_b')
                   Bool -> Bool -> Bool
|| (Int
xmid Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0 Bool -> Bool -> Bool
|| Int
ymid Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0 Bool -> Bool -> Bool
|| Int
xmid Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
l_a' Bool -> Bool -> Bool
|| Int
ymid Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
l_b'))
                     (ST s () -> ST s ()) -> ST s () -> ST s ()
forall a b. (a -> b) -> a -> b
$ [Char] -> ST s ()
forall a. HasCallStack => [Char] -> a
error [Char]
"impossible case"
             Int
c1 <- HArray
-> HArray
-> PArray
-> PArray
-> MapArray
-> MapArray
-> BSTArray s
-> BSTArray s
-> Int
-> Int
-> Int
-> Int
-> ST s Int
forall s.
HArray
-> HArray
-> PArray
-> PArray
-> MapArray
-> MapArray
-> BSTArray s
-> BSTArray s
-> Int
-> Int
-> Int
-> Int
-> ST s Int
cmpseq HArray
h_a HArray
h_b PArray
p_a PArray
p_b MapArray
m_a MapArray
m_b BSTArray s
c_a BSTArray s
c_b
                          Int
off_a' Int
off_b' Int
xmid Int
ymid
             Int
c2 <- HArray
-> HArray
-> PArray
-> PArray
-> MapArray
-> MapArray
-> BSTArray s
-> BSTArray s
-> Int
-> Int
-> Int
-> Int
-> ST s Int
forall s.
HArray
-> HArray
-> PArray
-> PArray
-> MapArray
-> MapArray
-> BSTArray s
-> BSTArray s
-> Int
-> Int
-> Int
-> Int
-> ST s Int
cmpseq HArray
h_a HArray
h_b PArray
p_a PArray
p_b MapArray
m_a MapArray
m_b BSTArray s
c_a BSTArray s
c_b
                          (Int
off_a' Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
xmid) (Int
off_b' Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
ymid)
                          (Int
l_a' Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
xmid) (Int
l_b' Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
ymid)
             Int -> ST s Int
forall (m :: * -> *) a. Monad m => a -> m a
return (Int -> ST s Int) -> Int -> ST s Int
forall a b. (a -> b) -> a -> b
$ Int
c1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
c2

-- | return (xmid, ymid, cost) for the two substrings
--   a[off_a+1..off_a+1+l_a] and b
findDiag :: Int -> HArray -> HArray -> PArray -> PArray -> MapArray -> MapArray
         -> VSTArray s -> VSTArray s -> Int -> Int -> Int -> Int -> Int -> Bool
         -> ST s (Int, Int, Int)
findDiag :: Int
-> HArray
-> HArray
-> PArray
-> PArray
-> MapArray
-> MapArray
-> VSTArray s
-> VSTArray s
-> Int
-> Int
-> Int
-> Int
-> Int
-> Bool
-> ST s (Int, Int, Int)
findDiag Int
c HArray
h_a HArray
h_b PArray
p_a PArray
p_b MapArray
m_a MapArray
m_b VSTArray s
v VSTArray s
vrev Int
off_a Int
off_b Int
l_a Int
l_b Int
del Bool
dodd = do
  Bool -> ST s () -> ST s ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
c Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
l_a Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
l_b) (ST s () -> ST s ()) -> ST s () -> ST s ()
forall a b. (a -> b) -> a -> b
$ [Char] -> ST s ()
forall a. HasCallStack => [Char] -> a
error [Char]
"findDiag failed"
  Maybe (Int, Int)
r <- ST s (Maybe (Int, Int))
findF
  case Maybe (Int, Int)
r of
    Just (Int
xmid, Int
ymid) -> (Int, Int, Int) -> ST s (Int, Int, Int)
forall (m :: * -> *) a. Monad m => a -> m a
return (Int
xmid, Int
ymid, Int
cInt -> Int -> Int
forall a. Num a => a -> a -> a
*Int
2 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)
    Maybe (Int, Int)
Nothing ->
      do Maybe (Int, Int)
r' <- ST s (Maybe (Int, Int))
findR
         case Maybe (Int, Int)
r' of
           Just (Int
xmid, Int
ymid) -> (Int, Int, Int) -> ST s (Int, Int, Int)
forall (m :: * -> *) a. Monad m => a -> m a
return (Int
xmid, Int
ymid, Int
cInt -> Int -> Int
forall a. Num a => a -> a -> a
*Int
2)
           Maybe (Int, Int)
Nothing -> Int
-> HArray
-> HArray
-> PArray
-> PArray
-> MapArray
-> MapArray
-> VSTArray s
-> VSTArray s
-> Int
-> Int
-> Int
-> Int
-> Int
-> Bool
-> ST s (Int, Int, Int)
forall s.
Int
-> HArray
-> HArray
-> PArray
-> PArray
-> MapArray
-> MapArray
-> VSTArray s
-> VSTArray s
-> Int
-> Int
-> Int
-> Int
-> Int
-> Bool
-> ST s (Int, Int, Int)
findDiag (Int
c Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) HArray
h_a HArray
h_b PArray
p_a PArray
p_b MapArray
m_a MapArray
m_b VSTArray s
v VSTArray s
vrev
                      Int
off_a Int
off_b Int
l_a Int
l_b Int
del Bool
dodd
 where fdmax :: Int
fdmax = if Int
c Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
l_a then Int
c else Int
l_a Int -> Int -> Int
forall a. Num a => a -> a -> a
- ((Int
l_a Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
c) Int -> Int -> Int
forall a. Integral a => a -> a -> a
`mod` Int
2)
       rdmax :: Int
rdmax = if Int
c Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
l_b then Int
c else Int
l_b Int -> Int -> Int
forall a. Num a => a -> a -> a
- ((Int
l_b Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
c) Int -> Int -> Int
forall a. Integral a => a -> a -> a
`mod` Int
2)
       lastrdmax :: Int
lastrdmax = if (Int
cInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1) Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
l_b then Int
cInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1 else Int
l_bInt -> Int -> Int
forall a. Num a => a -> a -> a
-(Int
l_b Int -> Int -> Int
forall a. Num a => a -> a -> a
+ (Int
cInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1) Int -> Int -> Int
forall a. Integral a => a -> a -> a
`mod` Int
2)
       lastrdmin :: Int
lastrdmin = -(if (Int
cInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1) Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
l_a then Int
cInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1 else Int
l_aInt -> Int -> Int
forall a. Num a => a -> a -> a
-((Int
l_a Int -> Int -> Int
forall a. Num a => a -> a -> a
+ (Int
cInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1)) Int -> Int -> Int
forall a. Integral a => a -> a -> a
`mod` Int
2))
       fdmin :: Int
fdmin = -Int
rdmax
       rdmin :: Int
rdmin = -Int
fdmax
       findF :: ST s (Maybe (Int, Int))
findF = Int -> ST s (Maybe (Int, Int))
findF' Int
fdmax
       findR :: ST s (Maybe (Int, Int))
findR = Int -> ST s (Maybe (Int, Int))
findR' Int
rdmax
       findF' :: Int -> ST s (Maybe (Int, Int))
findF' Int
d = do Int
x <- HArray
-> HArray
-> PArray
-> PArray
-> MapArray
-> MapArray
-> VSTArray s
-> Int
-> Int
-> Int
-> Int
-> Int
-> ST s Int
forall s.
HArray
-> HArray
-> PArray
-> PArray
-> MapArray
-> MapArray
-> VSTArray s
-> Int
-> Int
-> Int
-> Int
-> Int
-> ST s Int
findOne HArray
h_a HArray
h_b PArray
p_a PArray
p_b MapArray
m_a MapArray
m_b VSTArray s
v Int
d Int
off_a Int
off_b Int
l_a Int
l_b
                     if Bool
dodd Bool -> Bool -> Bool
&& Int
d Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
del Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
lastrdmin Bool -> Bool -> Bool
&& Int
d Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
del Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
lastrdmax
                        then do Int
xr <- VSTArray s -> Int -> ST s Int
forall (a :: * -> * -> *) e (m :: * -> *) i.
(MArray a e m, Ix i) =>
a i e -> i -> m e
readArray VSTArray s
vrev (Int
d Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
del)
                                if Int
xr Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
x then Maybe (Int, Int) -> ST s (Maybe (Int, Int))
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe (Int, Int) -> ST s (Maybe (Int, Int)))
-> Maybe (Int, Int) -> ST s (Maybe (Int, Int))
forall a b. (a -> b) -> a -> b
$ (Int, Int) -> Maybe (Int, Int)
forall a. a -> Maybe a
Just (Int
x, Int
x Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
d)
                                           else if Int
d Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
fdmin then Maybe (Int, Int) -> ST s (Maybe (Int, Int))
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (Int, Int)
forall a. Maybe a
Nothing
                                                              else Int -> ST s (Maybe (Int, Int))
findF' (Int
dInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
2)
                        else if Int
d Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
fdmin then Maybe (Int, Int) -> ST s (Maybe (Int, Int))
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (Int, Int)
forall a. Maybe a
Nothing else Int -> ST s (Maybe (Int, Int))
findF' (Int
dInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
2)
       findR' :: Int -> ST s (Maybe (Int, Int))
findR' Int
d = do Int
x <- HArray
-> HArray
-> PArray
-> PArray
-> MapArray
-> MapArray
-> VSTArray s
-> Int
-> Int
-> Int
-> Int
-> ST s Int
forall s.
HArray
-> HArray
-> PArray
-> PArray
-> MapArray
-> MapArray
-> VSTArray s
-> Int
-> Int
-> Int
-> Int
-> ST s Int
findOneRev HArray
h_a HArray
h_b PArray
p_a PArray
p_b MapArray
m_a MapArray
m_b VSTArray s
vrev Int
d Int
del Int
off_a Int
off_b
                     if Bool -> Bool
not Bool
dodd Bool -> Bool -> Bool
&& (Int
d Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
del Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
fdmin) Bool -> Bool -> Bool
&& (Int
d Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
del Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
fdmax)
                        then do Int
xf <- VSTArray s -> Int -> ST s Int
forall (a :: * -> * -> *) e (m :: * -> *) i.
(MArray a e m, Ix i) =>
a i e -> i -> m e
readArray VSTArray s
v (Int
d Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
del)
                                if Int
x Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
xf then Maybe (Int, Int) -> ST s (Maybe (Int, Int))
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe (Int, Int) -> ST s (Maybe (Int, Int)))
-> Maybe (Int, Int) -> ST s (Maybe (Int, Int))
forall a b. (a -> b) -> a -> b
$ (Int, Int) -> Maybe (Int, Int)
forall a. a -> Maybe a
Just (Int
x,Int
xInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
delInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
d)
                                           else if Int
d Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
rdmin then Maybe (Int, Int) -> ST s (Maybe (Int, Int))
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (Int, Int)
forall a. Maybe a
Nothing
                                                              else Int -> ST s (Maybe (Int, Int))
findR' (Int
dInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
2)
                        else if Int
d Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
rdmin then Maybe (Int, Int) -> ST s (Maybe (Int, Int))
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (Int, Int)
forall a. Maybe a
Nothing else Int -> ST s (Maybe (Int, Int))
findR' (Int
dInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
2)

-- | find position on diag d with one more insert/delete going forward
findOne  :: HArray -> HArray -> PArray -> PArray -> MapArray -> MapArray
         -> VSTArray s -> Int -> Int -> Int -> Int -> Int -> ST s Int
findOne :: HArray
-> HArray
-> PArray
-> PArray
-> MapArray
-> MapArray
-> VSTArray s
-> Int
-> Int
-> Int
-> Int
-> Int
-> ST s Int
findOne HArray
h_a HArray
h_b PArray
p_a PArray
p_b MapArray
m_a MapArray
m_b VSTArray s
v Int
d Int
off_a Int
off_b Int
l_a Int
l_b = do
  Int
x0 <- do Int
xbelow <- VSTArray s -> Int -> ST s Int
forall (a :: * -> * -> *) e (m :: * -> *) i.
(MArray a e m, Ix i) =>
a i e -> i -> m e
readArray VSTArray s
v (Int
d Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)
           Int
xover <- VSTArray s -> Int -> ST s Int
forall (a :: * -> * -> *) e (m :: * -> *) i.
(MArray a e m, Ix i) =>
a i e -> i -> m e
readArray VSTArray s
v (Int
d Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)
           Int -> ST s Int
forall (m :: * -> *) a. Monad m => a -> m a
return (Int -> ST s Int) -> Int -> ST s Int
forall a b. (a -> b) -> a -> b
$ if Int
xover Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
xbelow then Int
xover else Int
xbelow Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1
  let y0 :: Int
y0 = Int
x0 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
d
      x :: Int
x = HArray
-> HArray
-> PArray
-> PArray
-> MapArray
-> MapArray
-> Int
-> Int
-> Int
-> Int
-> Int
-> Int
-> Int
findSnake HArray
h_a HArray
h_b PArray
p_a PArray
p_b  MapArray
m_a MapArray
m_b (Int
x0Int -> Int -> Int
forall a. Num a => a -> a -> a
+Int
off_a) (Int
y0Int -> Int -> Int
forall a. Num a => a -> a -> a
+Int
off_b)
            Int
l_a Int
l_b Int
off_a Int
off_b
  VSTArray s -> Int -> Int -> ST s ()
forall (a :: * -> * -> *) e (m :: * -> *) i.
(MArray a e m, Ix i) =>
a i e -> i -> e -> m ()
writeArray VSTArray s
v Int
d (Int
x Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
off_a)
  Int -> ST s Int
forall (m :: * -> *) a. Monad m => a -> m a
return (Int
xInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
off_a)

-- | follow snake from northwest to southeast, x and y are absolute positions
findSnake :: HArray -> HArray -> PArray -> PArray -> MapArray -> MapArray
          -> Int -> Int -> Int -> Int -> Int -> Int -> Int
findSnake :: HArray
-> HArray
-> PArray
-> PArray
-> MapArray
-> MapArray
-> Int
-> Int
-> Int
-> Int
-> Int
-> Int
-> Int
findSnake HArray
h_a HArray
h_b PArray
p_a PArray
p_b  MapArray
m_a MapArray
m_b Int
x Int
y Int
l_a Int
l_b Int
off_a Int
off_b =
  if Int
x Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
l_a Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
off_a Bool -> Bool -> Bool
&& Int
y Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
l_b Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
off_b Bool -> Bool -> Bool
&& HArray
h_aHArray -> Int -> Int32
forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
a i e -> i -> e
!(Int
xInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) Int32 -> Int32 -> Bool
forall a. Eq a => a -> a -> Bool
== HArray
h_bHArray -> Int -> Int32
forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
a i e -> i -> e
!(Int
yInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1)
       Bool -> Bool -> Bool
&& (HArray
h_aHArray -> Int -> Int32
forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
a i e -> i -> e
!(Int
xInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) Int32 -> Int32 -> Bool
forall a. Eq a => a -> a -> Bool
/= Int32
markColl Bool -> Bool -> Bool
|| PArray
p_aPArray -> Int -> ByteString
forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
a i e -> i -> e
!(MapArray
m_aMapArray -> Int -> Int
forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
a i e -> i -> e
!(Int
xInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1)) ByteString -> ByteString -> Bool
forall a. Eq a => a -> a -> Bool
== PArray
p_bPArray -> Int -> ByteString
forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
a i e -> i -> e
!(MapArray
m_bMapArray -> Int -> Int
forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
a i e -> i -> e
!(Int
yInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1)))
     then HArray
-> HArray
-> PArray
-> PArray
-> MapArray
-> MapArray
-> Int
-> Int
-> Int
-> Int
-> Int
-> Int
-> Int
findSnake HArray
h_a HArray
h_b PArray
p_a PArray
p_b MapArray
m_a MapArray
m_b (Int
x Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) (Int
y Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) Int
l_a Int
l_b Int
off_a Int
off_b
     else Int
x

-- | find position on diag d with one more insert/delete going backward
findOneRev :: HArray -> HArray -> PArray -> PArray -> MapArray -> MapArray
           -> VSTArray s -> Int -> Int -> Int -> Int -> ST s Int
findOneRev :: HArray
-> HArray
-> PArray
-> PArray
-> MapArray
-> MapArray
-> VSTArray s
-> Int
-> Int
-> Int
-> Int
-> ST s Int
findOneRev HArray
h_a HArray
h_b PArray
p_a PArray
p_b MapArray
m_a MapArray
m_b VSTArray s
v Int
d Int
del Int
off_a Int
off_b = do
  Int
x0 <- do Int
xbelow <- VSTArray s -> Int -> ST s Int
forall (a :: * -> * -> *) e (m :: * -> *) i.
(MArray a e m, Ix i) =>
a i e -> i -> m e
readArray VSTArray s
v (Int
d Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)
           Int
xover <- VSTArray s -> Int -> ST s Int
forall (a :: * -> * -> *) e (m :: * -> *) i.
(MArray a e m, Ix i) =>
a i e -> i -> m e
readArray VSTArray s
v (Int
d Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)
           Int -> ST s Int
forall (m :: * -> *) a. Monad m => a -> m a
return (Int -> ST s Int) -> Int -> ST s Int
forall a b. (a -> b) -> a -> b
$ if Int
xbelow Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
xover then Int
xbelow else Int
xoverInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1
  let y0 :: Int
y0 = Int
x0 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
del Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
d
      x :: Int
x = HArray
-> HArray
-> PArray
-> PArray
-> MapArray
-> MapArray
-> Int
-> Int
-> Int
-> Int
-> Int
findSnakeRev HArray
h_a HArray
h_b PArray
p_a PArray
p_b MapArray
m_a MapArray
m_b (Int
x0Int -> Int -> Int
forall a. Num a => a -> a -> a
+Int
off_a) (Int
y0Int -> Int -> Int
forall a. Num a => a -> a -> a
+Int
off_b)
            Int
off_a Int
off_b
  VSTArray s -> Int -> Int -> ST s ()
forall (a :: * -> * -> *) e (m :: * -> *) i.
(MArray a e m, Ix i) =>
a i e -> i -> e -> m ()
writeArray VSTArray s
v Int
d (Int
xInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
off_a)
  Int -> ST s Int
forall (m :: * -> *) a. Monad m => a -> m a
return (Int
xInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
off_a)

-- | follow snake from southeast to northwest, x and y are absolute positions
findSnakeRev :: HArray -> HArray -> PArray -> PArray -> MapArray -> MapArray
             -> Int -> Int -> Int -> Int -> Int
findSnakeRev :: HArray
-> HArray
-> PArray
-> PArray
-> MapArray
-> MapArray
-> Int
-> Int
-> Int
-> Int
-> Int
findSnakeRev HArray
h_a HArray
h_b PArray
p_a PArray
p_b MapArray
m_a MapArray
m_b Int
x Int
y Int
off_a Int
off_b =
  if Int
x Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
off_a Bool -> Bool -> Bool
&& Int
y Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
off_b Bool -> Bool -> Bool
&& HArray
h_aHArray -> Int -> Int32
forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
a i e -> i -> e
!Int
x Int32 -> Int32 -> Bool
forall a. Eq a => a -> a -> Bool
== HArray
h_bHArray -> Int -> Int32
forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
a i e -> i -> e
!Int
y
       Bool -> Bool -> Bool
&& (HArray
h_aHArray -> Int -> Int32
forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
a i e -> i -> e
!Int
x Int32 -> Int32 -> Bool
forall a. Eq a => a -> a -> Bool
/= Int32
markColl Bool -> Bool -> Bool
|| PArray
p_aPArray -> Int -> ByteString
forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
a i e -> i -> e
!(MapArray
m_aMapArray -> Int -> Int
forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
a i e -> i -> e
!Int
x) ByteString -> ByteString -> Bool
forall a. Eq a => a -> a -> Bool
== PArray
p_bPArray -> Int -> ByteString
forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
a i e -> i -> e
!(MapArray
m_bMapArray -> Int -> Int
forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
a i e -> i -> e
!Int
y))
     then HArray
-> HArray
-> PArray
-> PArray
-> MapArray
-> MapArray
-> Int
-> Int
-> Int
-> Int
-> Int
findSnakeRev HArray
h_a HArray
h_b PArray
p_a PArray
p_b MapArray
m_a MapArray
m_b (Int
x Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) (Int
y Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) Int
off_a Int
off_b
     else Int
x

-- | try to create nicer diffs by shifting around regions of changed lines
shiftBoundaries :: BSTArray s -> BSTArray s -> PArray -> Int -> Int -> ST s ()
shiftBoundaries :: BSTArray s -> BSTArray s -> PArray -> Int -> Int -> ST s ()
shiftBoundaries BSTArray s
c_a BSTArray s
c_b PArray
p_a Int
i_ Int
j_ =
  do Maybe Int
x <- BSTArray s -> Int -> ST s (Maybe Int)
forall s. BSTArray s -> Int -> ST s (Maybe Int)
nextChanged BSTArray s
c_a Int
i_
     case Maybe Int
x of
       Just Int
start ->
             do let skipped :: Int
skipped = Int
start Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
i_
                Int
j1 <- BSTArray s -> Int -> Int -> ST s Int
forall s. BSTArray s -> Int -> Int -> ST s Int
nextUnchangedN BSTArray s
c_b Int
skipped Int
j_
                Int
end <- BSTArray s -> Int -> ST s Int
forall s. BSTArray s -> Int -> ST s Int
nextUnchanged BSTArray s
c_a Int
start
                Int
j2 <- BSTArray s -> Int -> ST s Int
forall s. BSTArray s -> Int -> ST s Int
nextUnchanged BSTArray s
c_b Int
j1
                (Int
i3,Int
j3) <- Int -> Int -> Int -> ST s (Int, Int)
expand Int
start Int
end Int
j2
                BSTArray s -> BSTArray s -> PArray -> Int -> Int -> ST s ()
forall s.
BSTArray s -> BSTArray s -> PArray -> Int -> Int -> ST s ()
shiftBoundaries BSTArray s
c_a BSTArray s
c_b PArray
p_a Int
i3 Int
j3
       Maybe Int
Nothing -> () -> ST s ()
forall (m :: * -> *) a. Monad m => a -> m a
return () -- no change up to end of file
 where noline :: Int
noline = PArray -> Int
forall (a :: * -> * -> *) e. IArray a e => a Int e -> Int
aLen PArray
p_a Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1
       expand :: Int -> Int -> Int -> ST s (Int, Int)
expand Int
start Int
i Int
j =
         do let len :: Int
len = Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
start
            (Int
start0,Int
i0,Int
j0) <- Int -> Int -> Int -> ST s (Int, Int, Int)
shiftBackward Int
start Int
i Int
j
            Bool
b <- if Int
j0 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
1 then BSTArray s -> Int -> ST s Bool
forall (a :: * -> * -> *) e (m :: * -> *) i.
(MArray a e m, Ix i) =>
a i e -> i -> m e
readArray BSTArray s
c_b (Int
j0Int -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1) else Bool -> ST s Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False
            let corr :: Int
corr = if Bool
b then Int
i0 else Int
noline
            let blank :: Int
blank = if PArray
p_aPArray -> Int -> ByteString
forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
a i e -> i -> e
!(Int
i0Int -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1) ByteString -> ByteString -> Bool
forall a. Eq a => a -> a -> Bool
== ByteString
B.empty then Int
i0
                                               else Int
noline
            (Int
start1,Int
i1,Int
j1,Int
corr1,Int
blank1) <- Int -> Int -> Int -> Int -> Int -> ST s (Int, Int, Int, Int, Int)
shiftForward Int
start0 Int
i0 Int
j0 Int
corr Int
blank
            -- prefer corresponding to ending with blank line
            let newi :: Int
newi = if Int
corr1 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
noline then Int
blank1
                                          else Int
corr1
            (Int
start2,Int
i2,Int
j2) <- Int -> Int -> Int -> Int -> ST s (Int, Int, Int)
moveCorr Int
start1 Int
i1 Int
j1 Int
newi
            if Int
len Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
i2 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
start2
                then Int -> Int -> Int -> ST s (Int, Int)
expand Int
start2 Int
i2 Int
j2
                else (Int, Int) -> ST s (Int, Int)
forall (m :: * -> *) a. Monad m => a -> m a
return (Int
i2, Int
j2)
       shiftBackward :: Int -> Int -> Int -> ST s (Int, Int, Int)
shiftBackward Int
start Int
i Int
j =
         if Int
start Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
1 Bool -> Bool -> Bool
&& PArray
p_aPArray -> Int -> ByteString
forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
a i e -> i -> e
!(Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1) ByteString -> ByteString -> Bool
forall a. Eq a => a -> a -> Bool
== PArray
p_aPArray -> Int -> ByteString
forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
a i e -> i -> e
!(Int
startInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1)
            then do Bool -> ST s () -> ST s ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
i Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
start) (ST s () -> ST s ()) -> ST s () -> ST s ()
forall a b. (a -> b) -> a -> b
$ [Char] -> ST s ()
forall a. HasCallStack => [Char] -> a
error [Char]
"impossible case"
                    Bool
b1 <- BSTArray s -> Int -> ST s Bool
forall (a :: * -> * -> *) e (m :: * -> *) i.
(MArray a e m, Ix i) =>
a i e -> i -> m e
readArray BSTArray s
c_a (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1)
                    Bool
b2 <- BSTArray s -> Int -> ST s Bool
forall (a :: * -> * -> *) e (m :: * -> *) i.
(MArray a e m, Ix i) =>
a i e -> i -> m e
readArray BSTArray s
c_a (Int
startInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1)
                    Bool -> ST s () -> ST s ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Bool -> Bool
not Bool
b1 Bool -> Bool -> Bool
|| Bool
b2) (ST s () -> ST s ()) -> ST s () -> ST s ()
forall a b. (a -> b) -> a -> b
$ [Char] -> ST s ()
forall a. HasCallStack => [Char] -> a
error [Char]
"impossible case"
                    BSTArray s -> Int -> Bool -> ST s ()
forall (a :: * -> * -> *) e (m :: * -> *) i.
(MArray a e m, Ix i) =>
a i e -> i -> e -> m ()
writeArray BSTArray s
c_a (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1) Bool
False
                    BSTArray s -> Int -> Bool -> ST s ()
forall (a :: * -> * -> *) e (m :: * -> *) i.
(MArray a e m, Ix i) =>
a i e -> i -> e -> m ()
writeArray BSTArray s
c_a (Int
startInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1) Bool
True
                    Bool
b <- if Int
start Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
2 then BSTArray s -> Int -> ST s Bool
forall (a :: * -> * -> *) e (m :: * -> *) i.
(MArray a e m, Ix i) =>
a i e -> i -> m e
readArray BSTArray s
c_a (Int
startInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
2)
                                      else Bool -> ST s Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False
                    Int
start' <- if Bool
b then (Int -> Int) -> ST s Int -> ST s Int
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM (Int
1Int -> Int -> Int
forall a. Num a => a -> a -> a
+) (BSTArray s -> Int -> ST s Int
forall s. BSTArray s -> Int -> ST s Int
prevUnchanged BSTArray s
c_a (Int
startInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
2))
                                   else Int -> ST s Int
forall (m :: * -> *) a. Monad m => a -> m a
return (Int
startInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1)
                    Int
j' <- BSTArray s -> Int -> ST s Int
forall s. BSTArray s -> Int -> ST s Int
prevUnchanged BSTArray s
c_b (Int
jInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1)
                    Int -> Int -> Int -> ST s (Int, Int, Int)
shiftBackward Int
start' (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1) Int
j'
            else (Int, Int, Int) -> ST s (Int, Int, Int)
forall (m :: * -> *) a. Monad m => a -> m a
return (Int
start,Int
i,Int
j)
       shiftForward :: Int -> Int -> Int -> Int -> Int -> ST s (Int, Int, Int, Int, Int)
shiftForward Int
start Int
i Int
j Int
corr Int
blank =
         if Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= PArray -> Int
forall (a :: * -> * -> *) e. IArray a e => a Int e -> Int
aLen PArray
p_a Bool -> Bool -> Bool
&& PArray
p_aPArray -> Int -> ByteString
forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
a i e -> i -> e
!Int
i ByteString -> ByteString -> Bool
forall a. Eq a => a -> a -> Bool
== PArray
p_aPArray -> Int -> ByteString
forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
a i e -> i -> e
!Int
start Bool -> Bool -> Bool
&&
             -- B.empty at the end of file marks empty line after final newline
             Bool -> Bool
not ((Int
i Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== PArray -> Int
forall (a :: * -> * -> *) e. IArray a e => a Int e -> Int
aLen PArray
p_a) Bool -> Bool -> Bool
&& (PArray
p_aPArray -> Int -> ByteString
forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
a i e -> i -> e
!Int
i ByteString -> ByteString -> Bool
forall a. Eq a => a -> a -> Bool
== ByteString
B.empty))
            then do Bool -> ST s () -> ST s ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
i Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
start) (ST s () -> ST s ()) -> ST s () -> ST s ()
forall a b. (a -> b) -> a -> b
$ [Char] -> ST s ()
forall a. HasCallStack => [Char] -> a
error [Char]
"impossible case"
                    Bool
b1 <- BSTArray s -> Int -> ST s Bool
forall (a :: * -> * -> *) e (m :: * -> *) i.
(MArray a e m, Ix i) =>
a i e -> i -> m e
readArray BSTArray s
c_a Int
i
                    Bool
b2 <- BSTArray s -> Int -> ST s Bool
forall (a :: * -> * -> *) e (m :: * -> *) i.
(MArray a e m, Ix i) =>
a i e -> i -> m e
readArray BSTArray s
c_a Int
start
                    Bool -> ST s () -> ST s ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Bool -> Bool
not Bool
b2 Bool -> Bool -> Bool
||  Bool
b1) (ST s () -> ST s ()) -> ST s () -> ST s ()
forall a b. (a -> b) -> a -> b
$ [Char] -> ST s ()
forall a. HasCallStack => [Char] -> a
error [Char]
"impossible case"
                    BSTArray s -> Int -> Bool -> ST s ()
forall (a :: * -> * -> *) e (m :: * -> *) i.
(MArray a e m, Ix i) =>
a i e -> i -> e -> m ()
writeArray BSTArray s
c_a Int
i Bool
True
                    BSTArray s -> Int -> Bool -> ST s ()
forall (a :: * -> * -> *) e (m :: * -> *) i.
(MArray a e m, Ix i) =>
a i e -> i -> e -> m ()
writeArray BSTArray s
c_a Int
start Bool
False
                    Int
i0 <- BSTArray s -> Int -> ST s Int
forall s. BSTArray s -> Int -> ST s Int
nextUnchanged BSTArray s
c_a (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1)
                    Int
j0 <- BSTArray s -> Int -> ST s Int
forall s. BSTArray s -> Int -> ST s Int
nextUnchanged BSTArray s
c_b (Int
jInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1)
                    let corr0 :: Int
corr0
                            | Int
i0 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) = Int
noline
                            | Int
j0Int -> Int -> Int
forall a. Num a => a -> a -> a
-Int
j Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
2 = Int
i0
                            | Bool
otherwise = Int
corr
                    let blank0 :: Int
blank0
                            | Int
i0 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1 = Int
noline
                            | PArray
p_aPArray -> Int -> ByteString
forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
a i e -> i -> e
!(Int
i0Int -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1) ByteString -> ByteString -> Bool
forall a. Eq a => a -> a -> Bool
== ByteString
B.empty = Int
i0
                            | Bool
otherwise = Int
blank
                    Int -> Int -> Int -> Int -> Int -> ST s (Int, Int, Int, Int, Int)
shiftForward (Int
startInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) Int
i0 Int
j0 Int
corr0 Int
blank0
            else (Int, Int, Int, Int, Int) -> ST s (Int, Int, Int, Int, Int)
forall (m :: * -> *) a. Monad m => a -> m a
return (Int
start,Int
i,Int
j,Int
corr,Int
blank)
       moveCorr :: Int -> Int -> Int -> Int -> ST s (Int, Int, Int)
moveCorr Int
start Int
i Int
j Int
corr =
         if Int
corr Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
i
            then (Int, Int, Int) -> ST s (Int, Int, Int)
forall (m :: * -> *) a. Monad m => a -> m a
return (Int
start,Int
i,Int
j)
            else do Bool
b1 <- BSTArray s -> Int -> ST s Bool
forall (a :: * -> * -> *) e (m :: * -> *) i.
(MArray a e m, Ix i) =>
a i e -> i -> m e
readArray BSTArray s
c_a (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1)
                    Bool
b2 <- BSTArray s -> Int -> ST s Bool
forall (a :: * -> * -> *) e (m :: * -> *) i.
(MArray a e m, Ix i) =>
a i e -> i -> m e
readArray BSTArray s
c_a (Int
startInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1)
                    Bool -> ST s () -> ST s ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Bool -> Bool
not Bool
b1 Bool -> Bool -> Bool
|| Bool
b2) (ST s () -> ST s ()) -> ST s () -> ST s ()
forall a b. (a -> b) -> a -> b
$ [Char] -> ST s ()
forall a. HasCallStack => [Char] -> a
error [Char]
"impossible case"
                    Bool -> ST s () -> ST s ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (PArray
p_aPArray -> Int -> ByteString
forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
a i e -> i -> e
!(Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1) ByteString -> ByteString -> Bool
forall a. Eq a => a -> a -> Bool
/= PArray
p_aPArray -> Int -> ByteString
forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
a i e -> i -> e
!(Int
startInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1)) (ST s () -> ST s ()) -> ST s () -> ST s ()
forall a b. (a -> b) -> a -> b
$ [Char] -> ST s ()
forall a. HasCallStack => [Char] -> a
error [Char]
"impossible case"
                    BSTArray s -> Int -> Bool -> ST s ()
forall (a :: * -> * -> *) e (m :: * -> *) i.
(MArray a e m, Ix i) =>
a i e -> i -> e -> m ()
writeArray BSTArray s
c_a (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1) Bool
False
                    BSTArray s -> Int -> Bool -> ST s ()
forall (a :: * -> * -> *) e (m :: * -> *) i.
(MArray a e m, Ix i) =>
a i e -> i -> e -> m ()
writeArray BSTArray s
c_a (Int
startInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1) Bool
True
                    Int
j' <- BSTArray s -> Int -> ST s Int
forall s. BSTArray s -> Int -> ST s Int
prevUnchanged BSTArray s
c_b (Int
jInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1)
                    Int -> Int -> Int -> Int -> ST s (Int, Int, Int)
moveCorr (Int
startInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1) (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1) Int
j' Int
corr

-- | goto next unchanged line, return the given line if unchanged
nextUnchanged :: BSTArray s -> Int -> ST s Int
nextUnchanged :: BSTArray s -> Int -> ST s Int
nextUnchanged BSTArray s
c Int
i = do
  Int
len <- BSTArray s -> ST s Int
forall (a :: * -> * -> *) e (m :: * -> *).
MArray a e m =>
a Int e -> m Int
aLenM BSTArray s
c
  if Int
i Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
len Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1 then Int -> ST s Int
forall (m :: * -> *) a. Monad m => a -> m a
return Int
i
     else do Bool
b <- BSTArray s -> Int -> ST s Bool
forall (a :: * -> * -> *) e (m :: * -> *) i.
(MArray a e m, Ix i) =>
a i e -> i -> m e
readArray BSTArray s
c Int
i
             if Bool
b then BSTArray s -> Int -> ST s Int
forall s. BSTArray s -> Int -> ST s Int
nextUnchanged BSTArray s
c (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1)
                  else Int -> ST s Int
forall (m :: * -> *) a. Monad m => a -> m a
return Int
i

-- | skip at least one unchanged line, if there is none advance
--   behind the last line
skipOneUnChanged :: BSTArray s -> Int -> ST s Int
skipOneUnChanged :: BSTArray s -> Int -> ST s Int
skipOneUnChanged BSTArray s
c Int
i = do
  Int
len <- BSTArray s -> ST s Int
forall (a :: * -> * -> *) e (m :: * -> *).
MArray a e m =>
a Int e -> m Int
aLenM BSTArray s
c
  if Int
i Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
len Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1
     then Int -> ST s Int
forall (m :: * -> *) a. Monad m => a -> m a
return Int
i
     else do Bool
b <- BSTArray s -> Int -> ST s Bool
forall (a :: * -> * -> *) e (m :: * -> *) i.
(MArray a e m, Ix i) =>
a i e -> i -> m e
readArray BSTArray s
c Int
i
             if Bool -> Bool
not Bool
b then Int -> ST s Int
forall (m :: * -> *) a. Monad m => a -> m a
return (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1)
                      else BSTArray s -> Int -> ST s Int
forall s. BSTArray s -> Int -> ST s Int
skipOneUnChanged BSTArray s
c (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1)

-- | goto n-th next unchanged line
nextUnchangedN :: BSTArray s -> Int -> Int -> ST s Int
nextUnchangedN :: BSTArray s -> Int -> Int -> ST s Int
nextUnchangedN BSTArray s
c Int
n Int
i =
  if Int
n Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 then Int -> ST s Int
forall (m :: * -> *) a. Monad m => a -> m a
return Int
i
            else do Int
i' <- BSTArray s -> Int -> ST s Int
forall s. BSTArray s -> Int -> ST s Int
skipOneUnChanged BSTArray s
c Int
i
                    BSTArray s -> Int -> Int -> ST s Int
forall s. BSTArray s -> Int -> Int -> ST s Int
nextUnchangedN BSTArray s
c (Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1) Int
i'

-- | goto next changed line, return the given line if changed
nextChanged :: BSTArray s -> Int -> ST s (Maybe Int)
nextChanged :: BSTArray s -> Int -> ST s (Maybe Int)
nextChanged BSTArray s
c Int
i = do
  Int
len <- BSTArray s -> ST s Int
forall (a :: * -> * -> *) e (m :: * -> *).
MArray a e m =>
a Int e -> m Int
aLenM BSTArray s
c
  if Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
len
    then do Bool
b <- BSTArray s -> Int -> ST s Bool
forall (a :: * -> * -> *) e (m :: * -> *) i.
(MArray a e m, Ix i) =>
a i e -> i -> m e
readArray BSTArray s
c Int
i
            if Bool -> Bool
not Bool
b then BSTArray s -> Int -> ST s (Maybe Int)
forall s. BSTArray s -> Int -> ST s (Maybe Int)
nextChanged BSTArray s
c (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1)
                     else 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
i
    else Maybe Int -> ST s (Maybe Int)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Int
forall a. Maybe a
Nothing

-- | goto previous unchanged line, return the given line if unchanged
prevUnchanged :: BSTArray s -> Int -> ST s Int
prevUnchanged :: BSTArray s -> Int -> ST s Int
prevUnchanged BSTArray s
c Int
i = do
  Bool
b <- BSTArray s -> Int -> ST s Bool
forall (a :: * -> * -> *) e (m :: * -> *) i.
(MArray a e m, Ix i) =>
a i e -> i -> m e
readArray BSTArray s
c Int
i
  if Bool
b then BSTArray s -> Int -> ST s Int
forall s. BSTArray s -> Int -> ST s Int
prevUnchanged BSTArray s
c (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1)
       else Int -> ST s Int
forall (m :: * -> *) a. Monad m => a -> m a
return Int
i

type HArray = UArray Int Int32
type BArray = UArray Int Bool
type PArray = Array Int B.ByteString
type MapArray = UArray Int Int
type VSTArray s = STUArray s Int Int
type BSTArray s = STUArray s Int Bool

initV :: Int -> ST s (VSTArray s)
initV :: Int -> ST s (VSTArray s)
initV Int
dmax = (Int, Int) -> Int -> ST s (VSTArray s)
forall (a :: * -> * -> *) e (m :: * -> *) i.
(MArray a e m, Ix i) =>
(i, i) -> e -> m (a i e)
newArray (-(Int
dmax Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1), Int
dmax Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) (-Int
1)

initVRev :: Int -> Int -> ST s (VSTArray s)
initVRev :: Int -> Int -> ST s (VSTArray s)
initVRev Int
dmax Int
xmax = (Int, Int) -> Int -> ST s (VSTArray s)
forall (a :: * -> * -> *) e (m :: * -> *) i.
(MArray a e m, Ix i) =>
(i, i) -> e -> m (a i e)
newArray (-(Int
dmax Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1), Int
dmax Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) (Int
xmax Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)

-- 1 indexed, v[0] is used as a guard element
initVChanged :: Int -> ST s (BSTArray s)
initVChanged :: Int -> ST s (BSTArray s)
initVChanged Int
l = do
  BSTArray s
a <- (Int, Int) -> Bool -> ST s (BSTArray s)
forall (a :: * -> * -> *) e (m :: * -> *) i.
(MArray a e m, Ix i) =>
(i, i) -> e -> m (a i e)
newArray (Int
0, Int
l) Bool
True
  BSTArray s -> Int -> Bool -> ST s ()
forall (a :: * -> * -> *) e (m :: * -> *) i.
(MArray a e m, Ix i) =>
a i e -> i -> e -> m ()
writeArray BSTArray s
a Int
0 Bool
False
  BSTArray s -> ST s (BSTArray s)
forall (m :: * -> *) a. Monad m => a -> m a
return BSTArray s
a
  -- set to false for all lines which have a mapping later
  -- other lines are only present in one of the files

initH :: [Int32] -> HArray
initH :: [Int32] -> HArray
initH [Int32]
a = (Int, Int) -> [Int32] -> HArray
forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
(i, i) -> [e] -> a i e
listArray (Int
0, [Int32] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Int32]
a) (Int32
0Int32 -> [Int32] -> [Int32]
forall a. a -> [a] -> [a]
:[Int32]
a)

initM :: [Int] -> MapArray
initM :: [Int] -> MapArray
initM [Int]
a = (Int, Int) -> [Int] -> MapArray
forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
(i, i) -> [e] -> a i e
listArray (Int
0, [Int] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Int]
a) (Int
0Int -> [Int] -> [Int]
forall a. a -> [a] -> [a]
:[Int]
a)

initP :: [B.ByteString] -> PArray
initP :: [ByteString] -> PArray
initP [ByteString]
a = (Int, Int) -> [ByteString] -> PArray
forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
(i, i) -> [e] -> a i e
listArray (Int
0, [ByteString] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [ByteString]
a) (ByteString
B.emptyByteString -> [ByteString] -> [ByteString]
forall a. a -> [a] -> [a]
:[ByteString]
a)

aLen :: (IArray a e) => a Int e -> Int
aLen :: a Int e -> Int
aLen a Int e
a = (Int, Int) -> Int
forall a b. (a, b) -> b
snd ((Int, Int) -> Int) -> (Int, Int) -> Int
forall a b. (a -> b) -> a -> b
$ a Int e -> (Int, Int)
forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
a i e -> (i, i)
bounds a Int e
a
aLenM :: (MArray a e m) => a Int e -> m Int
aLenM :: a Int e -> m Int
aLenM a Int e
a = (Int, Int) -> Int
forall a b. (a, b) -> b
snd ((Int, Int) -> Int) -> m (Int, Int) -> m Int
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
`liftM` a Int e -> m (Int, Int)
forall (a :: * -> * -> *) e (m :: * -> *) i.
(MArray a e m, Ix i) =>
a i e -> m (i, i)
getBounds a Int e
a

convertPatch :: Int -> PArray -> PArray -> (Int, Int, Int, Int)
             -> (Int,[B.ByteString],[B.ByteString])
convertPatch :: Int
-> PArray
-> PArray
-> (Int, Int, Int, Int)
-> (Int, [ByteString], [ByteString])
convertPatch Int
off PArray
a PArray
b (Int
a0,Int
a1,Int
b0,Int
b1)
 | Int
b0 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
b1 = (Int
b0Int -> Int -> Int
forall a. Num a => a -> a -> a
+Int
off,PArray -> Int -> Int -> [ByteString]
getDelete PArray
a Int
a0 Int
a1,[])
 | Int
a0 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
a1 = (Int
b0Int -> Int -> Int
forall a. Num a => a -> a -> a
+Int
off,[],PArray -> Int -> Int -> [ByteString]
getInsert PArray
b Int
b0 Int
b1)
 | Bool
otherwise = (Int
b0Int -> Int -> Int
forall a. Num a => a -> a -> a
+Int
off,PArray -> Int -> Int -> [ByteString]
getDelete PArray
a Int
a0 Int
a1,PArray -> Int -> Int -> [ByteString]
getInsert PArray
b Int
b0 Int
b1)

getInsert :: PArray -> Int -> Int -> [B.ByteString]
getInsert :: PArray -> Int -> Int -> [ByteString]
getInsert PArray
b Int
from Int
to
  | Int
from Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
to = []
  | Bool
otherwise = (PArray
bPArray -> Int -> ByteString
forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
a i e -> i -> e
!(Int
fromInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1))ByteString -> [ByteString] -> [ByteString]
forall a. a -> [a] -> [a]
:PArray -> Int -> Int -> [ByteString]
getInsert PArray
b (Int
fromInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) Int
to
getDelete :: PArray -> Int -> Int -> [B.ByteString]
getDelete :: PArray -> Int -> Int -> [ByteString]
getDelete PArray
a Int
from Int
to
  | Int
from Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
to = []
  | Bool
otherwise = (PArray
aPArray -> Int -> ByteString
forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
a i e -> i -> e
!(Int
fromInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1))ByteString -> [ByteString] -> [ByteString]
forall a. a -> [a] -> [a]
:PArray -> Int -> Int -> [ByteString]
getDelete PArray
a (Int
fromInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) Int
to

createPatch :: BArray -> BArray -> [(Int, Int, Int, Int)]
createPatch :: BArray -> BArray -> [(Int, Int, Int, Int)]
createPatch BArray
c_a BArray
c_b =
  [(Int, Int, Int, Int)] -> [(Int, Int, Int, Int)]
forall a. [a] -> [a]
reverse ([(Int, Int, Int, Int)] -> [(Int, Int, Int, Int)])
-> [(Int, Int, Int, Int)] -> [(Int, Int, Int, Int)]
forall a b. (a -> b) -> a -> b
$ BArray -> BArray -> Int -> Int -> [(Int, Int, Int, Int)]
createP BArray
c_a BArray
c_b (BArray -> Int
forall (a :: * -> * -> *) e. IArray a e => a Int e -> Int
aLen BArray
c_a) (BArray -> Int
forall (a :: * -> * -> *) e. IArray a e => a Int e -> Int
aLen BArray
c_b)

createP :: BArray -> BArray -> Int -> Int -> [(Int, Int, Int, Int)]
createP :: BArray -> BArray -> Int -> Int -> [(Int, Int, Int, Int)]
createP BArray
_ BArray
_ Int
0 Int
0 = []
createP BArray
c_a BArray
c_b Int
ia Int
ib =
  if BArray
c_aBArray -> Int -> Bool
forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
a i e -> i -> e
!Int
ia Bool -> Bool -> Bool
|| BArray
c_bBArray -> Int -> Bool
forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
a i e -> i -> e
!Int
ib
     then let ia' :: Int
ia' = BArray -> Int -> Int
skipChangedRev BArray
c_a Int
ia
              ib' :: Int
ib' = BArray -> Int -> Int
skipChangedRev BArray
c_b Int
ib
          in (Int
ia',Int
ia,Int
ib',Int
ib)(Int, Int, Int, Int)
-> [(Int, Int, Int, Int)] -> [(Int, Int, Int, Int)]
forall a. a -> [a] -> [a]
:BArray -> BArray -> Int -> Int -> [(Int, Int, Int, Int)]
createP BArray
c_a BArray
c_b Int
ia' Int
ib'
     else BArray -> BArray -> Int -> Int -> [(Int, Int, Int, Int)]
createP BArray
c_a BArray
c_b (Int
iaInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1) (Int
ibInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1)

skipChangedRev :: BArray -> Int -> Int
skipChangedRev :: BArray -> Int -> Int
skipChangedRev BArray
c Int
i = if Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
0 Bool -> Bool -> Bool
&& BArray
cBArray -> Int -> Bool
forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
a i e -> i -> e
!Int
i then BArray -> Int -> Int
skipChangedRev BArray
c (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1) else Int
i