{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# OPTIONS_GHC -Wno-unused-imports -Werror=name-shadowing #-}

-- | Myers Diff
--
-- This is an implementation of the O(ND) diff algorithm as described in
-- \"An O(ND) Difference Algorithm and Its Variations (1986)\"
-- <http://citeseerx.ist.psu.edu/viewdoc/summary?doi=10.1.1.4.6927>.
module Myers.Diff
  ( -- * Diffing
    Diff,
    PolyDiff (..),
    getTextDiff,
    getStringDiff,
    getGroupedStringDiff,
    getVectorDiff,
    getGroupedVectorDiff,
    getVectorDiffBy,
    getGroupedVectorDiffBy,

    -- ** Internals
    Edit (..),
    getEditScript,
    getEditScriptBy,
    computeDiffFromEditScript,
    computeGroupedDiffFromEditScript,

    -- ** Backwards compatibility with @Diff@
    getDiff,
    getDiffBy,
    getGroupedDiff,
    getGroupedDiffBy,
  )
where

import Control.DeepSeq (NFData)
import Control.Monad
import Control.Monad.ST
import Data.DList (DList)
import qualified Data.DList as DList
import Data.Maybe (fromJust)
import Data.STRef
import Data.Text (Text)
import qualified Data.Text as T
import qualified Data.Text.Array as TA
import Data.Vector (Vector, (!))
import qualified Data.Vector as V
import Data.Vector.Mutable (MVector)
import qualified Data.Vector.Mutable as MV
import GHC.Generics

type Diff a = PolyDiff a a

mapDiff :: (a -> b) -> Diff a -> Diff b
mapDiff :: forall a b. (a -> b) -> Diff a -> Diff b
mapDiff a -> b
f = (a -> b) -> (a -> b) -> PolyDiff a a -> PolyDiff b b
forall a c b d.
(a -> c) -> (b -> d) -> PolyDiff a b -> PolyDiff c d
bimapPolyDiff a -> b
f a -> b
f

-- | A value is either from the 'First' list, the 'Second' or from 'Both'.
-- 'Both' contains both the left and right values, in case you are using a form
-- of equality that doesn't check all data (for example, if you are using a
-- custom equality relation to only perform equality on side of a tuple).
data PolyDiff a b = First a | Second b | Both a b
  deriving (Int -> PolyDiff a b -> ShowS
[PolyDiff a b] -> ShowS
PolyDiff a b -> String
(Int -> PolyDiff a b -> ShowS)
-> (PolyDiff a b -> String)
-> ([PolyDiff a b] -> ShowS)
-> Show (PolyDiff a b)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall a b. (Show a, Show b) => Int -> PolyDiff a b -> ShowS
forall a b. (Show a, Show b) => [PolyDiff a b] -> ShowS
forall a b. (Show a, Show b) => PolyDiff a b -> String
$cshowsPrec :: forall a b. (Show a, Show b) => Int -> PolyDiff a b -> ShowS
showsPrec :: Int -> PolyDiff a b -> ShowS
$cshow :: forall a b. (Show a, Show b) => PolyDiff a b -> String
show :: PolyDiff a b -> String
$cshowList :: forall a b. (Show a, Show b) => [PolyDiff a b] -> ShowS
showList :: [PolyDiff a b] -> ShowS
Show, PolyDiff a b -> PolyDiff a b -> Bool
(PolyDiff a b -> PolyDiff a b -> Bool)
-> (PolyDiff a b -> PolyDiff a b -> Bool) -> Eq (PolyDiff a b)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall a b. (Eq a, Eq b) => PolyDiff a b -> PolyDiff a b -> Bool
$c== :: forall a b. (Eq a, Eq b) => PolyDiff a b -> PolyDiff a b -> Bool
== :: PolyDiff a b -> PolyDiff a b -> Bool
$c/= :: forall a b. (Eq a, Eq b) => PolyDiff a b -> PolyDiff a b -> Bool
/= :: PolyDiff a b -> PolyDiff a b -> Bool
Eq, (forall x. PolyDiff a b -> Rep (PolyDiff a b) x)
-> (forall x. Rep (PolyDiff a b) x -> PolyDiff a b)
-> Generic (PolyDiff a b)
forall x. Rep (PolyDiff a b) x -> PolyDiff a b
forall x. PolyDiff a b -> Rep (PolyDiff a b) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall a b x. Rep (PolyDiff a b) x -> PolyDiff a b
forall a b x. PolyDiff a b -> Rep (PolyDiff a b) x
$cfrom :: forall a b x. PolyDiff a b -> Rep (PolyDiff a b) x
from :: forall x. PolyDiff a b -> Rep (PolyDiff a b) x
$cto :: forall a b x. Rep (PolyDiff a b) x -> PolyDiff a b
to :: forall x. Rep (PolyDiff a b) x -> PolyDiff a b
Generic, PolyDiff a b -> ()
(PolyDiff a b -> ()) -> NFData (PolyDiff a b)
forall a. (a -> ()) -> NFData a
forall a b. (NFData a, NFData b) => PolyDiff a b -> ()
$crnf :: forall a b. (NFData a, NFData b) => PolyDiff a b -> ()
rnf :: PolyDiff a b -> ()
NFData)

bimapPolyDiff :: (a -> c) -> (b -> d) -> PolyDiff a b -> PolyDiff c d
bimapPolyDiff :: forall a c b d.
(a -> c) -> (b -> d) -> PolyDiff a b -> PolyDiff c d
bimapPolyDiff a -> c
f b -> d
g = \case
  First a
a -> c -> PolyDiff c d
forall a b. a -> PolyDiff a b
First (a -> c
f a
a)
  Second b
b -> d -> PolyDiff c d
forall a b. b -> PolyDiff a b
Second (b -> d
g b
b)
  Both a
a b
b -> c -> d -> PolyDiff c d
forall a b. a -> b -> PolyDiff a b
Both (a -> c
f a
a) (b -> d
g b
b)

-- |
--
-- For backward compatibility with 'Diff', use more specific functions if you can.
getDiff :: (Eq a) => [a] -> [a] -> [Diff a]
getDiff :: forall a. Eq a => [a] -> [a] -> [Diff a]
getDiff = (a -> a -> Bool) -> [a] -> [a] -> [PolyDiff a a]
forall a b. (a -> b -> Bool) -> [a] -> [b] -> [PolyDiff a b]
getDiffBy a -> a -> Bool
forall a. Eq a => a -> a -> Bool
(==)

-- |
--
-- For backward compatibility with 'Diff', use more specific functions if you can.
getDiffBy :: (a -> b -> Bool) -> [a] -> [b] -> [PolyDiff a b]
getDiffBy :: forall a b. (a -> b -> Bool) -> [a] -> [b] -> [PolyDiff a b]
getDiffBy a -> b -> Bool
eq [a]
as [b]
bs = Vector (PolyDiff a b) -> [PolyDiff a b]
forall a. Vector a -> [a]
V.toList ((a -> b -> Bool) -> Vector a -> Vector b -> Vector (PolyDiff a b)
forall a b.
(a -> b -> Bool) -> Vector a -> Vector b -> Vector (PolyDiff a b)
getVectorDiffBy a -> b -> Bool
eq ([a] -> Vector a
forall a. [a] -> Vector a
V.fromList [a]
as) ([b] -> Vector b
forall a. [a] -> Vector a
V.fromList [b]
bs))

-- |
--
-- For backward compatibility with 'Diff', use more specific functions if you can.
getGroupedDiff :: (Eq a) => [a] -> [a] -> [Diff [a]]
getGroupedDiff :: forall a. Eq a => [a] -> [a] -> [Diff [a]]
getGroupedDiff = (a -> a -> Bool) -> [a] -> [a] -> [PolyDiff [a] [a]]
forall a b. (a -> b -> Bool) -> [a] -> [b] -> [PolyDiff [a] [b]]
getGroupedDiffBy a -> a -> Bool
forall a. Eq a => a -> a -> Bool
(==)

-- |
--
-- For backward compatibility with 'Diff', use more specific functions if you can.
getGroupedDiffBy :: (a -> b -> Bool) -> [a] -> [b] -> [PolyDiff [a] [b]]
getGroupedDiffBy :: forall a b. (a -> b -> Bool) -> [a] -> [b] -> [PolyDiff [a] [b]]
getGroupedDiffBy a -> b -> Bool
eq [a]
as [b]
bs = Vector (PolyDiff [a] [b]) -> [PolyDiff [a] [b]]
forall a. Vector a -> [a]
V.toList ((PolyDiff (Vector a) (Vector b) -> PolyDiff [a] [b])
-> Vector (PolyDiff (Vector a) (Vector b))
-> Vector (PolyDiff [a] [b])
forall a b. (a -> b) -> Vector a -> Vector b
V.map ((Vector a -> [a])
-> (Vector b -> [b])
-> PolyDiff (Vector a) (Vector b)
-> PolyDiff [a] [b]
forall a c b d.
(a -> c) -> (b -> d) -> PolyDiff a b -> PolyDiff c d
bimapPolyDiff Vector a -> [a]
forall a. Vector a -> [a]
V.toList Vector b -> [b]
forall a. Vector a -> [a]
V.toList) ((a -> b -> Bool)
-> Vector a -> Vector b -> Vector (PolyDiff (Vector a) (Vector b))
forall a b.
(a -> b -> Bool)
-> Vector a -> Vector b -> Vector (PolyDiff (Vector a) (Vector b))
getGroupedVectorDiffBy a -> b -> Bool
eq ([a] -> Vector a
forall a. [a] -> Vector a
V.fromList [a]
as) ([b] -> Vector b
forall a. [a] -> Vector a
V.fromList [b]
bs)))

-- | 'Text' diff
--
-- Uses pack and unpack, so does not roundtrip.
-- It uses pack and unpack because 'Text' is not the same as @Vector Char@;
-- You can't index a text in O(1) time, it takes O(n) time.
getTextDiff :: Text -> Text -> Vector (Diff Text)
getTextDiff :: Text -> Text -> Vector (Diff Text)
getTextDiff Text
expected Text
actual = (Diff (Vector Char) -> Diff Text)
-> Vector (Diff (Vector Char)) -> Vector (Diff Text)
forall a b. (a -> b) -> Vector a -> Vector b
V.map ((Vector Char -> Text) -> Diff (Vector Char) -> Diff Text
forall a b. (a -> b) -> Diff a -> Diff b
mapDiff Vector Char -> Text
packFromVector) (Vector (Diff (Vector Char)) -> Vector (Diff Text))
-> Vector (Diff (Vector Char)) -> Vector (Diff Text)
forall a b. (a -> b) -> a -> b
$ Vector Char -> Vector Char -> Vector (Diff (Vector Char))
forall a. Eq a => Vector a -> Vector a -> Vector (Diff (Vector a))
getGroupedVectorDiff (Text -> Vector Char
unpackToVector Text
expected) (Text -> Vector Char
unpackToVector Text
actual)
  where
    packFromVector :: Vector Char -> Text
    packFromVector :: Vector Char -> Text
packFromVector = String -> Text
T.pack (String -> Text) -> (Vector Char -> String) -> Vector Char -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Vector Char -> String
forall a. Vector a -> [a]
V.toList
    unpackToVector :: Text -> Vector Char
    unpackToVector :: Text -> Vector Char
unpackToVector = String -> Vector Char
forall a. [a] -> Vector a
V.fromList (String -> Vector Char) -> (Text -> String) -> Text -> Vector Char
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
T.unpack

-- | 'String' diff
--
-- You probably want to use 'getTextDiff' with packed strings instead, but this
-- function doesn't have the roundtripping problem that 'getTextDiff' has.
getStringDiff :: String -> String -> [Diff Char]
getStringDiff :: String -> String -> [Diff Char]
getStringDiff String
actual String
expected = Vector (Diff Char) -> [Diff Char]
forall a. Vector a -> [a]
V.toList (Vector Char -> Vector Char -> Vector (Diff Char)
forall a. Eq a => Vector a -> Vector a -> Vector (Diff a)
getVectorDiff (String -> Vector Char
forall a. [a] -> Vector a
V.fromList String
actual) (String -> Vector Char
forall a. [a] -> Vector a
V.fromList String
expected))

-- | Grouped 'String' diff
--
-- Like 'getStringDiff' but with entire strings instead of individual characters.
getGroupedStringDiff :: String -> String -> [Diff String]
getGroupedStringDiff :: String -> String -> [Diff String]
getGroupedStringDiff String
actual String
expected = Vector (Diff String) -> [Diff String]
forall a. Vector a -> [a]
V.toList (Vector (Diff String) -> [Diff String])
-> Vector (Diff String) -> [Diff String]
forall a b. (a -> b) -> a -> b
$ (Diff (Vector Char) -> Diff String)
-> Vector (Diff (Vector Char)) -> Vector (Diff String)
forall a b. (a -> b) -> Vector a -> Vector b
V.map ((Vector Char -> String) -> Diff (Vector Char) -> Diff String
forall a b. (a -> b) -> Diff a -> Diff b
mapDiff Vector Char -> String
forall a. Vector a -> [a]
V.toList) (Vector (Diff (Vector Char)) -> Vector (Diff String))
-> Vector (Diff (Vector Char)) -> Vector (Diff String)
forall a b. (a -> b) -> a -> b
$ Vector Char -> Vector Char -> Vector (Diff (Vector Char))
forall a. Eq a => Vector a -> Vector a -> Vector (Diff (Vector a))
getGroupedVectorDiff (String -> Vector Char
forall a. [a] -> Vector a
V.fromList String
actual) (String -> Vector Char
forall a. [a] -> Vector a
V.fromList String
expected)

-- | Diff two 'Vector's
--
-- Prefer 'getGroupedVectorDiff' for performance reasons.
getVectorDiff :: (Eq a) => Vector a -> Vector a -> Vector (Diff a)
getVectorDiff :: forall a. Eq a => Vector a -> Vector a -> Vector (Diff a)
getVectorDiff = (a -> a -> Bool) -> Vector a -> Vector a -> Vector (PolyDiff a a)
forall a b.
(a -> b -> Bool) -> Vector a -> Vector b -> Vector (PolyDiff a b)
getVectorDiffBy a -> a -> Bool
forall a. Eq a => a -> a -> Bool
(==)

-- | Diff two 'Vector's with different types using a custom equality operator
--
-- Prefer 'getGroupedVectorDiffBy' for performance reasons.
getVectorDiffBy :: forall a b. (a -> b -> Bool) -> Vector a -> Vector b -> Vector (PolyDiff a b)
getVectorDiffBy :: forall a b.
(a -> b -> Bool) -> Vector a -> Vector b -> Vector (PolyDiff a b)
getVectorDiffBy a -> b -> Bool
eq Vector a
old Vector b
new = Vector a -> Vector b -> Vector Edit -> Vector (PolyDiff a b)
forall a b.
Vector a -> Vector b -> Vector Edit -> Vector (PolyDiff a b)
computeDiffFromEditScript Vector a
old Vector b
new ((a -> b -> Bool) -> Vector a -> Vector b -> Vector Edit
forall a b. (a -> b -> Bool) -> Vector a -> Vector b -> Vector Edit
getEditScriptBy a -> b -> Bool
eq Vector a
old Vector b
new)

-- | Diff two 'Vector's with grouped results
getGroupedVectorDiff :: (Eq a) => Vector a -> Vector a -> Vector (Diff (Vector a))
getGroupedVectorDiff :: forall a. Eq a => Vector a -> Vector a -> Vector (Diff (Vector a))
getGroupedVectorDiff = (a -> a -> Bool)
-> Vector a -> Vector a -> Vector (PolyDiff (Vector a) (Vector a))
forall a b.
(a -> b -> Bool)
-> Vector a -> Vector b -> Vector (PolyDiff (Vector a) (Vector b))
getGroupedVectorDiffBy a -> a -> Bool
forall a. Eq a => a -> a -> Bool
(==)

-- | Diff two 'Vector's with grouped results using a custom equality operator
getGroupedVectorDiffBy :: forall a b. (a -> b -> Bool) -> Vector a -> Vector b -> Vector (PolyDiff (Vector a) (Vector b))
getGroupedVectorDiffBy :: forall a b.
(a -> b -> Bool)
-> Vector a -> Vector b -> Vector (PolyDiff (Vector a) (Vector b))
getGroupedVectorDiffBy a -> b -> Bool
eq Vector a
old Vector b
new = Vector a
-> Vector b
-> Vector Edit
-> Vector (PolyDiff (Vector a) (Vector b))
forall a b.
Vector a
-> Vector b
-> Vector Edit
-> Vector (PolyDiff (Vector a) (Vector b))
computeGroupedDiffFromEditScript Vector a
old Vector b
new ((a -> b -> Bool) -> Vector a -> Vector b -> Vector Edit
forall a b. (a -> b -> Bool) -> Vector a -> Vector b -> Vector Edit
getEditScriptBy a -> b -> Bool
eq Vector a
old Vector b
new)

-- | Compute the edit script to turn a given 'Vector' into the second given 'Vector'
getEditScript :: forall a. (Eq a) => Vector a -> Vector a -> Vector Edit
getEditScript :: forall a. Eq a => Vector a -> Vector a -> Vector Edit
getEditScript = (a -> a -> Bool) -> Vector a -> Vector a -> Vector Edit
forall a b. (a -> b -> Bool) -> Vector a -> Vector b -> Vector Edit
getEditScriptBy a -> a -> Bool
forall a. Eq a => a -> a -> Bool
(==)

-- | Compute the edit script to turn a given 'Vector' into the second given 'Vector' with a custom equality relation
--
-- From https://blog.robertelder.org/diff-algorithm/
getEditScriptBy :: forall a b. (a -> b -> Bool) -> Vector a -> Vector b -> Vector Edit
getEditScriptBy :: forall a b. (a -> b -> Bool) -> Vector a -> Vector b -> Vector Edit
getEditScriptBy a -> b -> Bool
eq Vector a
old Vector b
new = [Edit] -> Vector Edit
forall a. [a] -> Vector a
V.fromList ([Edit] -> Vector Edit) -> [Edit] -> Vector Edit
forall a b. (a -> b) -> a -> b
$ DList Edit -> [Edit]
forall a. DList a -> [a]
DList.toList (DList Edit -> [Edit]) -> DList Edit -> [Edit]
forall a b. (a -> b) -> a -> b
$ (forall s. ST s (DList Edit)) -> DList Edit
forall a. (forall s. ST s a) -> a
runST ((forall s. ST s (DList Edit)) -> DList Edit)
-> (forall s. ST s (DList Edit)) -> DList Edit
forall a b. (a -> b) -> a -> b
$ Vector a -> Vector b -> Int -> Int -> ST s (DList Edit)
forall s. Vector a -> Vector b -> Int -> Int -> ST s (DList Edit)
go Vector a
old Vector b
new Int
0 Int
0
  where
    go :: forall s. Vector a -> Vector b -> Int -> Int -> ST s (DList Edit)
    go :: forall s. Vector a -> Vector b -> Int -> Int -> ST s (DList Edit)
go Vector a
e Vector b
f Int
i Int
j = do
      -- N,M,L,Z = len(e),len(f),len(e)+len(f),2*min(len(e),len(f))+2
      let upperN :: Int
          upperN :: Int
upperN = Vector a -> Int
forall a. Vector a -> Int
V.length Vector a
e

      let upperM :: Int
          upperM :: Int
upperM = Vector b -> Int
forall a. Vector a -> Int
V.length Vector b
f

      let upperL :: Int
          upperL :: Int
upperL = Int
upperN Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
upperM

      let upperZ :: Int
          upperZ :: Int
upperZ = Int
2 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int -> Int -> Int
forall a. Ord a => a -> a -> a
min Int
upperN Int
upperM Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
2

      -- if N > 0 and M > 0:
      if Int
upperN Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0 Bool -> Bool -> Bool
&& Int
upperM Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0
        then do
          -- w,g,p = N-M,[0]*Z,[0]*Z
          let w :: Int
              w :: Int
w = Int
upperN Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
upperM

          MVector s Int
g <- Int -> Int -> ST s (MVector (PrimState (ST s)) Int)
forall (m :: * -> *) a.
PrimMonad m =>
Int -> a -> m (MVector (PrimState m) a)
MV.replicate Int
upperZ Int
0 :: ST s (MVector s Int)

          MVector s Int
p <- Int -> Int -> ST s (MVector (PrimState (ST s)) Int)
forall (m :: * -> *) a.
PrimMonad m =>
Int -> a -> m (MVector (PrimState m) a)
MV.replicate Int
upperZ Int
0 :: ST s (MVector s Int)

          -- for h in range(0, (L//2+(L%2!=0))+1):
          let hs :: [Int]
              hs :: [Int]
hs = [Int
0 .. ((Int
upperL Int -> Int -> Int
forall a. Integral a => a -> a -> a
`quot` Int
2) Int -> Int -> Int
forall a. Num a => a -> a -> a
+ (if Int -> Bool
forall a. Integral a => a -> Bool
odd Int
upperL then Int
1 else Int
0))]

          Maybe (DList Edit)
mResult <- [Int]
-> (Int -> ST s (Maybe (DList Edit))) -> ST s (Maybe (DList Edit))
forall (m :: * -> *) a b.
Monad m =>
[a] -> (a -> m (Maybe b)) -> m (Maybe b)
forUntilJust [Int]
hs ((Int -> ST s (Maybe (DList Edit))) -> ST s (Maybe (DList Edit)))
-> (Int -> ST s (Maybe (DList Edit))) -> ST s (Maybe (DList Edit))
forall a b. (a -> b) -> a -> b
$ \Int
h -> do
            -- for r in range(0, 2):
            [Int]
-> (Int -> ST s (Maybe (DList Edit))) -> ST s (Maybe (DList Edit))
forall (m :: * -> *) a b.
Monad m =>
[a] -> (a -> m (Maybe b)) -> m (Maybe b)
forUntilJust [Int
0, Int
1 :: Int] ((Int -> ST s (Maybe (DList Edit))) -> ST s (Maybe (DList Edit)))
-> (Int -> ST s (Maybe (DList Edit))) -> ST s (Maybe (DList Edit))
forall a b. (a -> b) -> a -> b
$ \Int
r -> do
              -- c,d,o,m = (g,p,1,1) if r==0 else (p,g,0,-1)
              let (MVector s Int
c, MVector s Int
d, Int
o, Int
m) = if Int
r Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 then (MVector s Int
g, MVector s Int
p, Int
1, Int
1) else (MVector s Int
p, MVector s Int
g, Int
0, -Int
1)

              -- for k in range(-(h-2*max(0,h-M)), h-2*max(0,h-N)+1, 2):
              let lo :: Int
                  lo :: Int
lo = -(Int
h Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
2 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
0 (Int
h Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
upperM))

              let hi :: Int
                  hi :: Int
hi = Int
h Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
2 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
0 (Int
h Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
upperN)

              let ks :: [Int]
                  ks :: [Int]
ks = [Int
lo, Int
lo Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
2 .. Int
hi]

              [Int]
-> (Int -> ST s (Maybe (DList Edit))) -> ST s (Maybe (DList Edit))
forall (m :: * -> *) a b.
Monad m =>
[a] -> (a -> m (Maybe b)) -> m (Maybe b)
forUntilJust [Int]
ks ((Int -> ST s (Maybe (DList Edit))) -> ST s (Maybe (DList Edit)))
-> (Int -> ST s (Maybe (DList Edit))) -> ST s (Maybe (DList Edit))
forall a b. (a -> b) -> a -> b
$ \Int
k -> do
                -- a = c[(k+1)%Z] if (k==-h or k!=h and c[(k-1)%Z]<c[(k+1)%Z]) else c[(k-1)%Z]+1
                Int
initAVal <- do
                  let part1 :: Bool
part1 = Int
k Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== -Int
h

                  let part2 :: Bool
part2 = Int
k Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
h

                  -- (k+1)%Z
                  let kp1Ix :: Int
kp1Ix = (Int
k Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) Int -> Int -> Int
`modPortable` Int
upperZ

                  -- (k-1)%Z
                  let km1Ix :: Int
km1Ix = (Int
k Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) Int -> Int -> Int
`modPortable` Int
upperZ
                  if Bool
part1
                    then MVector (PrimState (ST s)) Int -> Int -> ST s Int
forall (m :: * -> *) a.
PrimMonad m =>
MVector (PrimState m) a -> Int -> m a
MV.unsafeRead MVector s Int
MVector (PrimState (ST s)) Int
c Int
kp1Ix
                    else do
                      if Bool
part2
                        then do
                          -- c[(k-1)%Z]
                          Int
km1 <- MVector (PrimState (ST s)) Int -> Int -> ST s Int
forall (m :: * -> *) a.
PrimMonad m =>
MVector (PrimState m) a -> Int -> m a
MV.unsafeRead MVector s Int
MVector (PrimState (ST s)) Int
c Int
km1Ix

                          -- c[(k+1)%Z]
                          Int
kp1 <- MVector (PrimState (ST s)) Int -> Int -> ST s Int
forall (m :: * -> *) a.
PrimMonad m =>
MVector (PrimState m) a -> Int -> m a
MV.unsafeRead MVector s Int
MVector (PrimState (ST s)) Int
c Int
kp1Ix
                          let part3 :: Bool
part3 = Int
km1 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
kp1
                          Int -> ST s Int
forall a. a -> ST s a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Int -> ST s Int) -> Int -> ST s Int
forall a b. (a -> b) -> a -> b
$
                            if Bool
part3
                              then Int
kp1
                              else Int
km1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1
                        else do
                          Int
km1 <- MVector (PrimState (ST s)) Int -> Int -> ST s Int
forall (m :: * -> *) a.
PrimMonad m =>
MVector (PrimState m) a -> Int -> m a
MV.unsafeRead MVector s Int
MVector (PrimState (ST s)) Int
c Int
km1Ix

                          Int -> ST s Int
forall a. a -> ST s a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Int -> ST s Int) -> Int -> ST s Int
forall a b. (a -> b) -> a -> b
$ Int
km1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1

                STRef s Int
a <- Int -> ST s (STRef s Int)
forall a s. a -> ST s (STRef s a)
newSTRef Int
initAVal

                -- b = a-k
                let initBVal :: Int
                    initBVal :: Int
initBVal = Int
initAVal Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
k

                STRef s Int
b <- Int -> ST s (STRef s Int)
forall a s. a -> ST s (STRef s a)
newSTRef Int
initBVal

                -- s,t = a,b
                STRef s Int
s <- Int -> ST s (STRef s Int)
forall a s. a -> ST s (STRef s a)
newSTRef Int
initAVal
                STRef s Int
t <- Int -> ST s (STRef s Int)
forall a s. a -> ST s (STRef s a)
newSTRef Int
initBVal

                -- while a<N and b<M and e[(1-o)*N+m*a+(o-1)]==f[(1-o)*M+m*b+(o-1)]:
                let computeWhileCond :: ST s Bool
computeWhileCond = do
                      Int
aVal <- STRef s Int -> ST s Int
forall s a. STRef s a -> ST s a
readSTRef STRef s Int
a
                      -- a<N
                      let part1 :: Bool
part1 = Int
aVal Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
upperN
                      if Bool
part1
                        then do
                          Int
bVal <- STRef s Int -> ST s Int
forall s a. STRef s a -> ST s a
readSTRef STRef s Int
b
                          -- b<M
                          let part2 :: Bool
part2 = Int
bVal Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
upperM
                          -- e[(1-o)*N+m*a+(o-1)]==f[(1-o)*M+m*b+(o-1)]:
                          let mkPart3 :: ST s Bool
mkPart3 = do
                                let imo :: Int
imo = Int
1 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
o
                                    omi :: Int
omi = Int
o Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1
                                -- e[(1-o)*N+m*a+(o-1)]
                                a
leftVal <- do
                                  -- (1-o)*N+m*a+(o-1)
                                  let ix :: Int
ix = Int
imo Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
upperN Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
m Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
aVal Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
omi

                                  a -> ST s a
forall a. a -> ST s a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (a -> ST s a) -> a -> ST s a
forall a b. (a -> b) -> a -> b
$ Vector a
e Vector a -> Int -> a
forall a. Vector a -> Int -> a
! Int
ix
                                -- f[(1-o)*M+m*b+(o-1)]
                                b
rightVal <- do
                                  -- (1-o)*M+m*b+(o-1)
                                  let ix :: Int
ix = Int
imo Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
upperM Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
m Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
bVal Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
omi

                                  b -> ST s b
forall a. a -> ST s a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (b -> ST s b) -> b -> ST s b
forall a b. (a -> b) -> a -> b
$ Vector b
f Vector b -> Int -> b
forall a. Vector a -> Int -> a
! Int
ix
                                Bool -> ST s Bool
forall a. a -> ST s a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Bool -> ST s Bool) -> Bool -> ST s Bool
forall a b. (a -> b) -> a -> b
$ a
leftVal a -> b -> Bool
`eq` b
rightVal
                          Bool
part2 Bool -> ST s Bool -> ST s Bool
forall (m :: * -> *). Applicative m => Bool -> m Bool -> m Bool
&&. ST s Bool
mkPart3
                        else Bool -> ST s Bool
forall a. a -> ST s a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
False
                ST s Bool -> ST s () -> ST s ()
forall (m :: * -> *) a. Monad m => m Bool -> m a -> m ()
whileM_ ST s Bool
computeWhileCond (ST s () -> ST s ()) -> ST s () -> ST s ()
forall a b. (a -> b) -> a -> b
$ do
                  --   a,b = a+1,b+1
                  STRef s Int -> (Int -> Int) -> ST s ()
forall s a. STRef s a -> (a -> a) -> ST s ()
modifySTRef STRef s Int
a (Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)
                  STRef s Int -> (Int -> Int) -> ST s ()
forall s a. STRef s a -> (a -> a) -> ST s ()
modifySTRef STRef s Int
b (Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)
                -- c[k%Z],z=a,-(k-w)
                do
                  Int
aVal <- STRef s Int -> ST s Int
forall s a. STRef s a -> ST s a
readSTRef STRef s Int
a

                  MVector (PrimState (ST s)) Int -> Int -> Int -> ST s ()
forall (m :: * -> *) a.
PrimMonad m =>
MVector (PrimState m) a -> Int -> a -> m ()
MV.unsafeWrite MVector s Int
MVector (PrimState (ST s)) Int
c (Int
k Int -> Int -> Int
`modPortable` Int
upperZ) Int
aVal

                let z :: Int
z = -(Int
k Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
w)

                -- if L%2==o and z>=-(h-o) and z<=h-o and c[k%Z]+d[z%Z] >= N:
                let -- L%2==o
                    part1 :: Bool
part1 = Int
upperL Int -> Int -> Int
forall a. Integral a => a -> a -> a
`rem` Int
2 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
o
                    -- (h-o)
                    hmo :: Int
hmo = Int
h Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
o
                    -- z>=-(h-o)
                    part2 :: Bool
part2 = Int
z Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= -Int
hmo
                    -- z<=h-o
                    part3 :: Bool
part3 = Int
z Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
hmo
                    -- c[k%Z]+d[z%Z] >= N
                    mkPart4 :: ST s Bool
mkPart4 = do
                      Int
ck <- MVector (PrimState (ST s)) Int -> Int -> ST s Int
forall (m :: * -> *) a.
PrimMonad m =>
MVector (PrimState m) a -> Int -> m a
MV.unsafeRead MVector s Int
MVector (PrimState (ST s)) Int
c (Int
k Int -> Int -> Int
`modPortable` Int
upperZ)

                      Int
dz <- MVector (PrimState (ST s)) Int -> Int -> ST s Int
forall (m :: * -> *) a.
PrimMonad m =>
MVector (PrimState m) a -> Int -> m a
MV.unsafeRead MVector s Int
MVector (PrimState (ST s)) Int
d (Int
z Int -> Int -> Int
`modPortable` Int
upperZ)

                      Bool -> ST s Bool
forall a. a -> ST s a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Int
ck Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
dz Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
upperN)
                    mkCondition :: ST s Bool
mkCondition = Bool
part1 Bool -> ST s Bool -> ST s Bool
forall (m :: * -> *). Applicative m => Bool -> m Bool -> m Bool
&&. (Bool
part2 Bool -> ST s Bool -> ST s Bool
forall (m :: * -> *). Applicative m => Bool -> m Bool -> m Bool
&&. (Bool
part3 Bool -> ST s Bool -> ST s Bool
forall (m :: * -> *). Applicative m => Bool -> m Bool -> m Bool
&&. ST s Bool
mkPart4))
                Bool
condition <- ST s Bool
mkCondition
                if Bool
condition
                  then do
                    -- D,x,y,u,v = (2*h-1,s,t,a,b) if o==1 else (2*h,N-a,M-b,N-s,M-t)
                    (Int
upperD, Int
x, Int
y, Int
u, Int
v) <- do
                      Int
aVal <- STRef s Int -> ST s Int
forall s a. STRef s a -> ST s a
readSTRef STRef s Int
a
                      Int
bVal <- STRef s Int -> ST s Int
forall s a. STRef s a -> ST s a
readSTRef STRef s Int
b
                      Int
sVal <- STRef s Int -> ST s Int
forall s a. STRef s a -> ST s a
readSTRef STRef s Int
s
                      Int
tVal <- STRef s Int -> ST s Int
forall s a. STRef s a -> ST s a
readSTRef STRef s Int
t
                      (Int, Int, Int, Int, Int) -> ST s (Int, Int, Int, Int, Int)
forall a. a -> ST s a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ((Int, Int, Int, Int, Int) -> ST s (Int, Int, Int, Int, Int))
-> (Int, Int, Int, Int, Int) -> ST s (Int, Int, Int, Int, Int)
forall a b. (a -> b) -> a -> b
$
                        if Int
o Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
1
                          then (Int
2 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
h Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1, Int
sVal, Int
tVal, Int
aVal, Int
bVal)
                          else (Int
2 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
h, Int
upperN Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
aVal, Int
upperM Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
bVal, Int
upperN Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
sVal, Int
upperM Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
tVal)

                    -- if D > 1 or (x != u and y != v):
                    if Int
upperD Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
1 Bool -> Bool -> Bool
|| (Int
x Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
u Bool -> Bool -> Bool
&& Int
y Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
v)
                      then do
                        -- return diff(e[0:x],f[0:y],i,j)+diff(e[u:N],f[v:M],i+u,j+v)
                        -- diff(e[0:x],f[0:y],i,j)
                        DList Edit
firstHalf <- Vector a -> Vector b -> Int -> Int -> ST s (DList Edit)
forall s. Vector a -> Vector b -> Int -> Int -> ST s (DList Edit)
go (Int -> Int -> Vector a -> Vector a
forall a. Int -> Int -> Vector a -> Vector a
V.slice Int
0 Int
x Vector a
e) (Int -> Int -> Vector b -> Vector b
forall a. Int -> Int -> Vector a -> Vector a
V.slice Int
0 Int
y Vector b
f) Int
i Int
j
                        -- diff(e[u:N],f[v:M],i+u,j+v)
                        DList Edit
secondHalf <- Vector a -> Vector b -> Int -> Int -> ST s (DList Edit)
forall s. Vector a -> Vector b -> Int -> Int -> ST s (DList Edit)
go (Int -> Int -> Vector a -> Vector a
forall a. Int -> Int -> Vector a -> Vector a
sliceIx Int
u Int
upperN Vector a
e) (Int -> Int -> Vector b -> Vector b
forall a. Int -> Int -> Vector a -> Vector a
sliceIx Int
v Int
upperM Vector b
f) (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
u) (Int
j Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
v)
                        Maybe (DList Edit) -> ST s (Maybe (DList Edit))
forall a. a -> ST s a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (DList Edit -> Maybe (DList Edit)
forall a. a -> Maybe a
Just (DList Edit
firstHalf DList Edit -> DList Edit -> DList Edit
forall a. Semigroup a => a -> a -> a
<> DList Edit
secondHalf))
                      else -- elif M > N:

                        if Int
upperM Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
upperN
                          then do
                            -- return diff([],f[N:M],i+N,j+N)
                            DList Edit -> Maybe (DList Edit)
forall a. a -> Maybe a
Just (DList Edit -> Maybe (DList Edit))
-> ST s (DList Edit) -> ST s (Maybe (DList Edit))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Vector a -> Vector b -> Int -> Int -> ST s (DList Edit)
forall s. Vector a -> Vector b -> Int -> Int -> ST s (DList Edit)
go Vector a
forall a. Vector a
V.empty (Int -> Int -> Vector b -> Vector b
forall a. Int -> Int -> Vector a -> Vector a
sliceIx Int
upperN Int
upperM Vector b
f) (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
upperN) (Int
j Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
upperN)
                          else -- elif M < N:

                            if Int
upperM Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
upperN
                              then do
                                --   return diff(e[M:N],[],i+M,j+M)
                                DList Edit -> Maybe (DList Edit)
forall a. a -> Maybe a
Just (DList Edit -> Maybe (DList Edit))
-> ST s (DList Edit) -> ST s (Maybe (DList Edit))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Vector a -> Vector b -> Int -> Int -> ST s (DList Edit)
forall s. Vector a -> Vector b -> Int -> Int -> ST s (DList Edit)
go (Int -> Int -> Vector a -> Vector a
forall a. Int -> Int -> Vector a -> Vector a
sliceIx Int
upperM Int
upperN Vector a
e) Vector b
forall a. Vector a
V.empty (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
upperM) (Int
j Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
upperM)
                              else -- else:
                              --   return []
                                Maybe (DList Edit) -> ST s (Maybe (DList Edit))
forall a. a -> ST s a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (DList Edit -> Maybe (DList Edit)
forall a. a -> Maybe a
Just DList Edit
forall a. Monoid a => a
mempty)
                  else Maybe (DList Edit) -> ST s (Maybe (DList Edit))
forall a. a -> ST s a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe (DList Edit)
forall a. Maybe a
Nothing
          case Maybe (DList Edit)
mResult of
            Maybe (DList Edit)
Nothing -> String -> ST s (DList Edit)
forall a. HasCallStack => String -> a
error String
"Diff: This is a bug, the diffing algorithm was supposed to terminate and it didn't."
            Just DList Edit
result -> DList Edit -> ST s (DList Edit)
forall a. a -> ST s a
forall (f :: * -> *) a. Applicative f => a -> f a
pure DList Edit
result
        else do
          -- elif N > 0: #  Modify the return statements below if you want a different edit
          if Int
upperN Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0
            then do
              -- return [{"operation": "delete", "position_old": i+n} for n in range(0,N)]

              DList Edit -> ST s (DList Edit)
forall a. a -> ST s a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (DList Edit -> ST s (DList Edit))
-> DList Edit -> ST s (DList Edit)
forall a b. (a -> b) -> a -> b
$ Edit -> DList Edit
forall a. a -> DList a
DList.singleton (Int -> Int -> Edit
Delete Int
i Int
upperN)
            else do
              -- return [{"operation": "insert", "position_old": i,"position_new":j+n} for n in range(0,M)]
              if Int
upperM Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0
                then do
                  DList Edit -> ST s (DList Edit)
forall a. a -> ST s a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (DList Edit -> ST s (DList Edit))
-> DList Edit -> ST s (DList Edit)
forall a b. (a -> b) -> a -> b
$ Edit -> DList Edit
forall a. a -> DList a
DList.singleton (Int -> Int -> Int -> Edit
Insert Int
i Int
j Int
upperM)
                else do
                  DList Edit -> ST s (DList Edit)
forall a. a -> ST s a
forall (f :: * -> *) a. Applicative f => a -> f a
pure DList Edit
forall a. DList a
DList.empty

-- | Compute a diff using an edit script.
--
-- Prefer `computeGroupedDiffFromEditScript` for performance reasons.
computeGroupedDiffFromEditScript :: Vector a -> Vector b -> Vector Edit -> Vector (PolyDiff (Vector a) (Vector b))
computeGroupedDiffFromEditScript :: forall a b.
Vector a
-> Vector b
-> Vector Edit
-> Vector (PolyDiff (Vector a) (Vector b))
computeGroupedDiffFromEditScript Vector a
old Vector b
new Vector Edit
editSteps = (forall s. ST s (MVector s (PolyDiff (Vector a) (Vector b))))
-> Vector (PolyDiff (Vector a) (Vector b))
forall a. (forall s. ST s (MVector s a)) -> Vector a
V.create ((forall s. ST s (MVector s (PolyDiff (Vector a) (Vector b))))
 -> Vector (PolyDiff (Vector a) (Vector b)))
-> (forall s. ST s (MVector s (PolyDiff (Vector a) (Vector b))))
-> Vector (PolyDiff (Vector a) (Vector b))
forall a b. (a -> b) -> a -> b
$ do
  -- Computing the exact size is cumbersome, so we make enough space and cut down later.
  -- Enough space means: Space between every two edit steps, and one before and one after.
  let size :: Int
size = Vector Edit -> Int
forall a. Vector a -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length Vector Edit
editSteps Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
2 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1
  MVector s (PolyDiff (Vector a) (Vector b))
v <- Int
-> ST
     s (MVector (PrimState (ST s)) (PolyDiff (Vector a) (Vector b)))
forall (m :: * -> *) a.
PrimMonad m =>
Int -> m (MVector (PrimState m) a)
MV.new Int
size
  STRef s Int
groupMarker <- Int -> ST s (STRef s Int)
forall a s. a -> ST s (STRef s a)
newSTRef Int
0

  STRef s Int
oldMarker <- Int -> ST s (STRef s Int)
forall a s. a -> ST s (STRef s a)
newSTRef Int
0
  STRef s Int
curMarker <- Int -> ST s (STRef s Int)
forall a s. a -> ST s (STRef s a)
newSTRef Int
0
  STRef s Int
newMarker <- Int -> ST s (STRef s Int)
forall a s. a -> ST s (STRef s a)
newSTRef Int
0

  Vector Edit -> (Edit -> ST s ()) -> ST s ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ Vector Edit
editSteps ((Edit -> ST s ()) -> ST s ()) -> (Edit -> ST s ()) -> ST s ()
forall a b. (a -> b) -> a -> b
$ \Edit
editStep -> do
    -- Copy over the pieces between the last and current edit
    Int
inbetweenIx <- STRef s Int -> ST s Int
forall s a. STRef s a -> ST s a
readSTRef STRef s Int
oldMarker
    let inbetweenLen :: Int
inbetweenLen = Edit -> Int
oldPosition Edit
editStep Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
inbetweenIx
    Bool -> ST s () -> ST s ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
inbetweenLen 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
$ do
      Int
groupIx <- STRef s Int -> ST s Int
forall s a. STRef s a -> ST s a
readSTRef STRef s Int
groupMarker
      Int
oldIx <- STRef s Int -> ST s Int
forall s a. STRef s a -> ST s a
readSTRef STRef s Int
oldMarker
      Int
newIx <- STRef s Int -> ST s Int
forall s a. STRef s a -> ST s a
readSTRef STRef s Int
newMarker
      MVector (PrimState (ST s)) (PolyDiff (Vector a) (Vector b))
-> Int -> PolyDiff (Vector a) (Vector b) -> ST s ()
forall (m :: * -> *) a.
PrimMonad m =>
MVector (PrimState m) a -> Int -> a -> m ()
MV.unsafeWrite MVector s (PolyDiff (Vector a) (Vector b))
MVector (PrimState (ST s)) (PolyDiff (Vector a) (Vector b))
v Int
groupIx (Vector a -> Vector b -> PolyDiff (Vector a) (Vector b)
forall a b. a -> b -> PolyDiff a b
Both (Int -> Int -> Vector a -> Vector a
forall a. Int -> Int -> Vector a -> Vector a
V.slice Int
oldIx Int
inbetweenLen Vector a
old) (Int -> Int -> Vector b -> Vector b
forall a. Int -> Int -> Vector a -> Vector a
V.slice Int
newIx Int
inbetweenLen Vector b
new))
      STRef s Int -> (Int -> Int) -> ST s ()
forall s a. STRef s a -> (a -> a) -> ST s ()
modifySTRef STRef s Int
groupMarker (Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)
      STRef s Int -> (Int -> Int) -> ST s ()
forall s a. STRef s a -> (a -> a) -> ST s ()
modifySTRef STRef s Int
oldMarker (Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
inbetweenLen)
      STRef s Int -> (Int -> Int) -> ST s ()
forall s a. STRef s a -> (a -> a) -> ST s ()
modifySTRef STRef s Int
curMarker (Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
inbetweenLen)
      STRef s Int -> (Int -> Int) -> ST s ()
forall s a. STRef s a -> (a -> a) -> ST s ()
modifySTRef STRef s Int
newMarker (Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
inbetweenLen)

    -- Apply the edit
    case Edit
editStep of
      Delete Int
oldPosStart Int
upperN -> do
        Int
groupIx <- STRef s Int -> ST s Int
forall s a. STRef s a -> ST s a
readSTRef STRef s Int
groupMarker
        MVector (PrimState (ST s)) (PolyDiff (Vector a) (Vector b))
-> Int -> PolyDiff (Vector a) (Vector b) -> ST s ()
forall (m :: * -> *) a.
PrimMonad m =>
MVector (PrimState m) a -> Int -> a -> m ()
MV.unsafeWrite MVector s (PolyDiff (Vector a) (Vector b))
MVector (PrimState (ST s)) (PolyDiff (Vector a) (Vector b))
v Int
groupIx (Vector a -> PolyDiff (Vector a) (Vector b)
forall a b. a -> PolyDiff a b
First (Int -> Int -> Vector a -> Vector a
forall a. Int -> Int -> Vector a -> Vector a
V.slice Int
oldPosStart Int
upperN Vector a
old))
        STRef s Int -> (Int -> Int) -> ST s ()
forall s a. STRef s a -> (a -> a) -> ST s ()
modifySTRef STRef s Int
groupMarker (Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)
        STRef s Int -> (Int -> Int) -> ST s ()
forall s a. STRef s a -> (a -> a) -> ST s ()
modifySTRef STRef s Int
oldMarker (Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
upperN)
        STRef s Int -> (Int -> Int) -> ST s ()
forall s a. STRef s a -> (a -> a) -> ST s ()
modifySTRef STRef s Int
curMarker (Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
upperN)
      Insert Int
_ Int
newPosStart Int
upperM -> do
        Int
groupIx <- STRef s Int -> ST s Int
forall s a. STRef s a -> ST s a
readSTRef STRef s Int
groupMarker
        MVector (PrimState (ST s)) (PolyDiff (Vector a) (Vector b))
-> Int -> PolyDiff (Vector a) (Vector b) -> ST s ()
forall (m :: * -> *) a.
PrimMonad m =>
MVector (PrimState m) a -> Int -> a -> m ()
MV.unsafeWrite MVector s (PolyDiff (Vector a) (Vector b))
MVector (PrimState (ST s)) (PolyDiff (Vector a) (Vector b))
v Int
groupIx (Vector b -> PolyDiff (Vector a) (Vector b)
forall a b. b -> PolyDiff a b
Second (Int -> Int -> Vector b -> Vector b
forall a. Int -> Int -> Vector a -> Vector a
V.slice Int
newPosStart Int
upperM Vector b
new))
        STRef s Int -> (Int -> Int) -> ST s ()
forall s a. STRef s a -> (a -> a) -> ST s ()
modifySTRef STRef s Int
groupMarker (Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)
        STRef s Int -> (Int -> Int) -> ST s ()
forall s a. STRef s a -> (a -> a) -> ST s ()
modifySTRef STRef s Int
curMarker (Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
upperM)
        STRef s Int -> (Int -> Int) -> ST s ()
forall s a. STRef s a -> (a -> a) -> ST s ()
modifySTRef STRef s Int
newMarker (Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
upperM)

  Int
oldIx <- STRef s Int -> ST s Int
forall s a. STRef s a -> ST s a
readSTRef STRef s Int
oldMarker
  let afterLen :: Int
afterLen = Vector a -> Int
forall a. Vector a -> Int
V.length Vector a
old Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
oldIx
  Bool -> ST s () -> ST s ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
afterLen 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
$ do
    Int
newIx <- STRef s Int -> ST s Int
forall s a. STRef s a -> ST s a
readSTRef STRef s Int
newMarker
    Int
groupIx <- STRef s Int -> ST s Int
forall s a. STRef s a -> ST s a
readSTRef STRef s Int
groupMarker
    MVector (PrimState (ST s)) (PolyDiff (Vector a) (Vector b))
-> Int -> PolyDiff (Vector a) (Vector b) -> ST s ()
forall (m :: * -> *) a.
PrimMonad m =>
MVector (PrimState m) a -> Int -> a -> m ()
MV.unsafeWrite MVector s (PolyDiff (Vector a) (Vector b))
MVector (PrimState (ST s)) (PolyDiff (Vector a) (Vector b))
v Int
groupIx (Vector a -> Vector b -> PolyDiff (Vector a) (Vector b)
forall a b. a -> b -> PolyDiff a b
Both (Int -> Int -> Vector a -> Vector a
forall a. Int -> Int -> Vector a -> Vector a
V.slice Int
oldIx Int
afterLen Vector a
old) (Int -> Int -> Vector b -> Vector b
forall a. Int -> Int -> Vector a -> Vector a
V.slice Int
newIx Int
afterLen Vector b
new))
    STRef s Int -> (Int -> Int) -> ST s ()
forall s a. STRef s a -> (a -> a) -> ST s ()
modifySTRef STRef s Int
groupMarker (Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)
    STRef s Int -> (Int -> Int) -> ST s ()
forall s a. STRef s a -> (a -> a) -> ST s ()
modifySTRef STRef s Int
oldMarker (Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)
    STRef s Int -> (Int -> Int) -> ST s ()
forall s a. STRef s a -> (a -> a) -> ST s ()
modifySTRef STRef s Int
curMarker (Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)
    STRef s Int -> (Int -> Int) -> ST s ()
forall s a. STRef s a -> (a -> a) -> ST s ()
modifySTRef STRef s Int
newMarker (Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)

  Int
endGroupIx <- STRef s Int -> ST s Int
forall s a. STRef s a -> ST s a
readSTRef STRef s Int
groupMarker

  MVector s (PolyDiff (Vector a) (Vector b))
-> ST s (MVector s (PolyDiff (Vector a) (Vector b)))
forall a. a -> ST s a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Int
-> Int
-> MVector s (PolyDiff (Vector a) (Vector b))
-> MVector s (PolyDiff (Vector a) (Vector b))
forall s a. Int -> Int -> MVector s a -> MVector s a
MV.slice Int
0 Int
endGroupIx MVector s (PolyDiff (Vector a) (Vector b))
v)

-- | Compute a diff using an edit script.
--
-- Prefer `computeGroupedDiffFromEditScript` for performance reasons.
computeDiffFromEditScript :: Vector a -> Vector b -> Vector Edit -> Vector (PolyDiff a b)
computeDiffFromEditScript :: forall a b.
Vector a -> Vector b -> Vector Edit -> Vector (PolyDiff a b)
computeDiffFromEditScript Vector a
old Vector b
new Vector Edit
editSteps = (forall s. ST s (MVector s (PolyDiff a b)))
-> Vector (PolyDiff a b)
forall a. (forall s. ST s (MVector s a)) -> Vector a
V.create ((forall s. ST s (MVector s (PolyDiff a b)))
 -> Vector (PolyDiff a b))
-> (forall s. ST s (MVector s (PolyDiff a b)))
-> Vector (PolyDiff a b)
forall a b. (a -> b) -> a -> b
$ do
  -- The total size of the diff is the size of the old vector plus the number
  -- of inserts that need to happen.
  -- Not minus the number of deletions, because they get a 'First' constructor and stay.
  let totalSize :: Int
totalSize = Vector a -> Int
forall a. Vector a -> Int
V.length Vector a
old Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Vector Int -> Int
forall a. Num a => Vector a -> a
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum ((Edit -> Int) -> Vector Edit -> Vector Int
forall a b. (a -> b) -> Vector a -> Vector b
V.map Edit -> Int
insertLength Vector Edit
editSteps)

  MVector s (PolyDiff a b)
v <- Int -> ST s (MVector (PrimState (ST s)) (PolyDiff a b))
forall (m :: * -> *) a.
PrimMonad m =>
Int -> m (MVector (PrimState m) a)
MV.new Int
totalSize
  STRef s Int
oldMarker <- Int -> ST s (STRef s Int)
forall a s. a -> ST s (STRef s a)
newSTRef Int
0
  STRef s Int
curMarker <- Int -> ST s (STRef s Int)
forall a s. a -> ST s (STRef s a)
newSTRef Int
0
  STRef s Int
newMarker <- Int -> ST s (STRef s Int)
forall a s. a -> ST s (STRef s a)
newSTRef Int
0

  Vector Edit -> (Edit -> ST s ()) -> ST s ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ Vector Edit
editSteps ((Edit -> ST s ()) -> ST s ()) -> (Edit -> ST s ()) -> ST s ()
forall a b. (a -> b) -> a -> b
$ \Edit
editStep -> do
    let computeWhileCond1 :: ST s Bool
computeWhileCond1 = do
          Int
oldIx <- STRef s Int -> ST s Int
forall s a. STRef s a -> ST s a
readSTRef STRef s Int
oldMarker
          Bool -> ST s Bool
forall a. a -> ST s a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Bool -> ST s Bool) -> Bool -> ST s Bool
forall a b. (a -> b) -> a -> b
$ Edit -> Int
oldPosition Edit
editStep Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
oldIx
    -- Copy over the pieces between the last and current edit
    ST s Bool -> ST s () -> ST s ()
forall (m :: * -> *) a. Monad m => m Bool -> m a -> m ()
whileM_ ST s Bool
computeWhileCond1 (ST s () -> ST s ()) -> ST s () -> ST s ()
forall a b. (a -> b) -> a -> b
$ do
      Int
oldIx <- STRef s Int -> ST s Int
forall s a. STRef s a -> ST s a
readSTRef STRef s Int
oldMarker
      Int
curIx <- STRef s Int -> ST s Int
forall s a. STRef s a -> ST s a
readSTRef STRef s Int
curMarker
      Int
newIx <- STRef s Int -> ST s Int
forall s a. STRef s a -> ST s a
readSTRef STRef s Int
newMarker
      MVector (PrimState (ST s)) (PolyDiff a b)
-> Int -> PolyDiff a b -> ST s ()
forall (m :: * -> *) a.
PrimMonad m =>
MVector (PrimState m) a -> Int -> a -> m ()
MV.unsafeWrite MVector s (PolyDiff a b)
MVector (PrimState (ST s)) (PolyDiff a b)
v Int
curIx (a -> b -> PolyDiff a b
forall a b. a -> b -> PolyDiff a b
Both (Vector a
old Vector a -> Int -> a
forall a. Vector a -> Int -> a
! Int
oldIx) (Vector b
new Vector b -> Int -> b
forall a. Vector a -> Int -> a
! Int
newIx))
      STRef s Int -> (Int -> Int) -> ST s ()
forall s a. STRef s a -> (a -> a) -> ST s ()
modifySTRef STRef s Int
oldMarker (Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)
      STRef s Int -> (Int -> Int) -> ST s ()
forall s a. STRef s a -> (a -> a) -> ST s ()
modifySTRef STRef s Int
curMarker (Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)
      STRef s Int -> (Int -> Int) -> ST s ()
forall s a. STRef s a -> (a -> a) -> ST s ()
modifySTRef STRef s Int
newMarker (Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)

    -- Apply the edit
    case Edit
editStep of
      Delete Int
oldPosStart Int
upperN -> do
        Int
curIx <- STRef s Int -> ST s Int
forall s a. STRef s a -> ST s a
readSTRef STRef s Int
curMarker
        [Int] -> (Int -> ST s ()) -> ST s ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [Int
0 .. Int
upperN Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1] ((Int -> ST s ()) -> ST s ()) -> (Int -> ST s ()) -> ST s ()
forall a b. (a -> b) -> a -> b
$ \Int
n -> do
          MVector (PrimState (ST s)) (PolyDiff a b)
-> Int -> PolyDiff a b -> ST s ()
forall (m :: * -> *) a.
PrimMonad m =>
MVector (PrimState m) a -> Int -> a -> m ()
MV.unsafeWrite MVector s (PolyDiff a b)
MVector (PrimState (ST s)) (PolyDiff a b)
v (Int
curIx Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
n) (a -> PolyDiff a b
forall a b. a -> PolyDiff a b
First (Vector a
old Vector a -> Int -> a
forall a. Vector a -> Int -> a
! (Int
oldPosStart Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
n)))
        STRef s Int -> (Int -> Int) -> ST s ()
forall s a. STRef s a -> (a -> a) -> ST s ()
modifySTRef STRef s Int
oldMarker (Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
upperN)
        STRef s Int -> (Int -> Int) -> ST s ()
forall s a. STRef s a -> (a -> a) -> ST s ()
modifySTRef STRef s Int
curMarker (Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
upperN)
      Insert Int
_ Int
newPosStart Int
upperM -> do
        Int
curIx <- STRef s Int -> ST s Int
forall s a. STRef s a -> ST s a
readSTRef STRef s Int
curMarker
        [Int] -> (Int -> ST s ()) -> ST s ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [Int
0 .. Int
upperM Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1] ((Int -> ST s ()) -> ST s ()) -> (Int -> ST s ()) -> ST s ()
forall a b. (a -> b) -> a -> b
$ \Int
n -> do
          MVector (PrimState (ST s)) (PolyDiff a b)
-> Int -> PolyDiff a b -> ST s ()
forall (m :: * -> *) a.
PrimMonad m =>
MVector (PrimState m) a -> Int -> a -> m ()
MV.unsafeWrite MVector s (PolyDiff a b)
MVector (PrimState (ST s)) (PolyDiff a b)
v (Int
curIx Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
n) (b -> PolyDiff a b
forall a b. b -> PolyDiff a b
Second (Vector b
new Vector b -> Int -> b
forall a. Vector a -> Int -> a
! (Int
newPosStart Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
n)))
        STRef s Int -> (Int -> Int) -> ST s ()
forall s a. STRef s a -> (a -> a) -> ST s ()
modifySTRef STRef s Int
curMarker (Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
upperM)
        STRef s Int -> (Int -> Int) -> ST s ()
forall s a. STRef s a -> (a -> a) -> ST s ()
modifySTRef STRef s Int
newMarker (Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
upperM)

  let computeWhileCond2 :: ST s Bool
computeWhileCond2 = do
        Int
oldIx <- STRef s Int -> ST s Int
forall s a. STRef s a -> ST s a
readSTRef STRef s Int
oldMarker
        Bool -> ST s Bool
forall a. a -> ST s a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Bool -> ST s Bool) -> Bool -> ST s Bool
forall a b. (a -> b) -> a -> b
$ Int
oldIx Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Vector a -> Int
forall a. Vector a -> Int
V.length Vector a
old

  -- Copy over the pieces between the last and current edit
  ST s Bool -> ST s () -> ST s ()
forall (m :: * -> *) a. Monad m => m Bool -> m a -> m ()
whileM_ ST s Bool
computeWhileCond2 (ST s () -> ST s ()) -> ST s () -> ST s ()
forall a b. (a -> b) -> a -> b
$ do
    Int
oldIx <- STRef s Int -> ST s Int
forall s a. STRef s a -> ST s a
readSTRef STRef s Int
oldMarker
    Int
curIx <- STRef s Int -> ST s Int
forall s a. STRef s a -> ST s a
readSTRef STRef s Int
curMarker
    Int
newIx <- STRef s Int -> ST s Int
forall s a. STRef s a -> ST s a
readSTRef STRef s Int
newMarker

    MVector (PrimState (ST s)) (PolyDiff a b)
-> Int -> PolyDiff a b -> ST s ()
forall (m :: * -> *) a.
PrimMonad m =>
MVector (PrimState m) a -> Int -> a -> m ()
MV.unsafeWrite MVector s (PolyDiff a b)
MVector (PrimState (ST s)) (PolyDiff a b)
v Int
curIx (a -> b -> PolyDiff a b
forall a b. a -> b -> PolyDiff a b
Both (Vector a
old Vector a -> Int -> a
forall a. Vector a -> Int -> a
! Int
oldIx) (Vector b
new Vector b -> Int -> b
forall a. Vector a -> Int -> a
! Int
newIx))
    STRef s Int -> (Int -> Int) -> ST s ()
forall s a. STRef s a -> (a -> a) -> ST s ()
modifySTRef STRef s Int
oldMarker (Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)
    STRef s Int -> (Int -> Int) -> ST s ()
forall s a. STRef s a -> (a -> a) -> ST s ()
modifySTRef STRef s Int
curMarker (Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)
    STRef s Int -> (Int -> Int) -> ST s ()
forall s a. STRef s a -> (a -> a) -> ST s ()
modifySTRef STRef s Int
newMarker (Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)

  MVector s (PolyDiff a b) -> ST s (MVector s (PolyDiff a b))
forall a. a -> ST s a
forall (f :: * -> *) a. Applicative f => a -> f a
pure MVector s (PolyDiff a b)
v

data Edit
  = -- | Delete from the old vector
    Delete
      -- position in the old vector
      Int
      -- number of items to delete
      Int
  | -- | Insert into the old vector
    Insert
      -- position in the old vector
      Int
      -- position in the new vector
      Int
      -- number of items to insert
      Int
  deriving (Int -> Edit -> ShowS
[Edit] -> ShowS
Edit -> String
(Int -> Edit -> ShowS)
-> (Edit -> String) -> ([Edit] -> ShowS) -> Show Edit
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Edit -> ShowS
showsPrec :: Int -> Edit -> ShowS
$cshow :: Edit -> String
show :: Edit -> String
$cshowList :: [Edit] -> ShowS
showList :: [Edit] -> ShowS
Show, Edit -> Edit -> Bool
(Edit -> Edit -> Bool) -> (Edit -> Edit -> Bool) -> Eq Edit
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Edit -> Edit -> Bool
== :: Edit -> Edit -> Bool
$c/= :: Edit -> Edit -> Bool
/= :: Edit -> Edit -> Bool
Eq, Eq Edit
Eq Edit =>
(Edit -> Edit -> Ordering)
-> (Edit -> Edit -> Bool)
-> (Edit -> Edit -> Bool)
-> (Edit -> Edit -> Bool)
-> (Edit -> Edit -> Bool)
-> (Edit -> Edit -> Edit)
-> (Edit -> Edit -> Edit)
-> Ord Edit
Edit -> Edit -> Bool
Edit -> Edit -> Ordering
Edit -> Edit -> Edit
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: Edit -> Edit -> Ordering
compare :: Edit -> Edit -> Ordering
$c< :: Edit -> Edit -> Bool
< :: Edit -> Edit -> Bool
$c<= :: Edit -> Edit -> Bool
<= :: Edit -> Edit -> Bool
$c> :: Edit -> Edit -> Bool
> :: Edit -> Edit -> Bool
$c>= :: Edit -> Edit -> Bool
>= :: Edit -> Edit -> Bool
$cmax :: Edit -> Edit -> Edit
max :: Edit -> Edit -> Edit
$cmin :: Edit -> Edit -> Edit
min :: Edit -> Edit -> Edit
Ord)

oldPosition :: Edit -> Int
oldPosition :: Edit -> Int
oldPosition = \case
  Delete Int
i Int
_ -> Int
i
  Insert Int
i Int
_ Int
_ -> Int
i

insertLength :: Edit -> Int
insertLength :: Edit -> Int
insertLength = \case
  Delete Int
_ Int
_ -> Int
0
  Insert Int
_ Int
_ Int
m -> Int
m

modPortable :: Int -> Int -> Int
modPortable :: Int -> Int -> Int
modPortable Int
a Int
b =
  let r :: Int
r = Int
a Int -> Int -> Int
forall a. Integral a => a -> a -> a
`rem` Int
b
   in if Int
r Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
0 then Int
r else Int
r Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
b

sliceIx :: Int -> Int -> Vector a -> Vector a
sliceIx :: forall a. Int -> Int -> Vector a -> Vector a
sliceIx Int
start Int
end = Int -> Int -> Vector a -> Vector a
forall a. Int -> Int -> Vector a -> Vector a
V.slice Int
start (Int
end Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
start)

-- | Short-circuiting monadic (&&)
(&&.) :: (Applicative m) => Bool -> m Bool -> m Bool
&&. :: forall (m :: * -> *). Applicative m => Bool -> m Bool -> m Bool
(&&.) Bool
b1 m Bool
mkB2 = do
  if Bool
b1
    then m Bool
mkB2
    else Bool -> m Bool
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
False

forUntilJust :: (Monad m) => [a] -> (a -> m (Maybe b)) -> m (Maybe b)
forUntilJust :: forall (m :: * -> *) a b.
Monad m =>
[a] -> (a -> m (Maybe b)) -> m (Maybe b)
forUntilJust [] a -> m (Maybe b)
_ = Maybe b -> m (Maybe b)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe b
forall a. Maybe a
Nothing
forUntilJust (a
a : [a]
rest) a -> m (Maybe b)
func = do
  Maybe b
mRes <- a -> m (Maybe b)
func a
a
  case Maybe b
mRes of
    Maybe b
Nothing -> [a] -> (a -> m (Maybe b)) -> m (Maybe b)
forall (m :: * -> *) a b.
Monad m =>
[a] -> (a -> m (Maybe b)) -> m (Maybe b)
forUntilJust [a]
rest a -> m (Maybe b)
func
    Just b
res -> Maybe b -> m (Maybe b)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe b -> m (Maybe b)) -> Maybe b -> m (Maybe b)
forall a b. (a -> b) -> a -> b
$ b -> Maybe b
forall a. a -> Maybe a
Just b
res

whileM_ :: (Monad m) => m Bool -> m a -> m ()
whileM_ :: forall (m :: * -> *) a. Monad m => m Bool -> m a -> m ()
whileM_ m Bool
p m a
f = m ()
go
  where
    go :: m ()
go = do
      Bool
x <- m Bool
p
      if Bool
x
        then m a
f m a -> m () -> m ()
forall a b. m a -> m b -> m b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> m ()
go
        else () -> m ()
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ()