{-# LANGUAGE ScopedTypeVariables #-}
module Test.StateMachine.TreeDiff.List (diffBy, Edit (..)) where
import Data.List.Compat (sortOn)
import qualified Data.MemoTrie as M
import qualified Data.Vector as V
data Edit a
= Ins a
| Del a
| Cpy a
| Swp a a
deriving Int -> Edit a -> ShowS
forall a. Show a => Int -> Edit a -> ShowS
forall a. Show a => [Edit a] -> ShowS
forall a. Show a => Edit a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Edit a] -> ShowS
$cshowList :: forall a. Show a => [Edit a] -> ShowS
show :: Edit a -> String
$cshow :: forall a. Show a => Edit a -> String
showsPrec :: Int -> Edit a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> Edit a -> ShowS
Show
diffBy :: forall a. (a -> a -> Bool) -> [a] -> [a] -> [Edit a]
diffBy :: forall a. (a -> a -> Bool) -> [a] -> [a] -> [Edit a]
diffBy a -> a -> Bool
eq [a]
xs' [a]
ys' = forall a. [a] -> [a]
reverse (forall a b. (a, b) -> b
snd (Int -> Int -> (Int, [Edit a])
lcs (forall a. Vector a -> Int
V.length Vector a
xs) (forall a. Vector a -> Int
V.length Vector a
ys)))
where
xs :: Vector a
xs = forall a. [a] -> Vector a
V.fromList [a]
xs'
ys :: Vector a
ys = forall a. [a] -> Vector a
V.fromList [a]
ys'
lcs :: Int -> Int -> (Int, [Edit a])
lcs = forall s t a.
(HasTrie s, HasTrie t) =>
(s -> t -> a) -> s -> t -> a
M.memo2 Int -> Int -> (Int, [Edit a])
impl
impl :: Int -> Int -> (Int, [Edit a])
impl :: Int -> Int -> (Int, [Edit a])
impl Int
0 Int
0 = (Int
0, [])
impl Int
0 Int
m = case Int -> Int -> (Int, [Edit a])
lcs Int
0 (Int
mforall a. Num a => a -> a -> a
-Int
1) of
(Int
w, [Edit a]
edit) -> (Int
w forall a. Num a => a -> a -> a
+ Int
1, forall a. a -> Edit a
Ins (Vector a
ys forall a. Vector a -> Int -> a
V.! (Int
m forall a. Num a => a -> a -> a
- Int
1)) forall a. a -> [a] -> [a]
: [Edit a]
edit)
impl Int
n Int
0 = case Int -> Int -> (Int, [Edit a])
lcs (Int
n forall a. Num a => a -> a -> a
-Int
1) Int
0 of
(Int
w, [Edit a]
edit) -> (Int
w forall a. Num a => a -> a -> a
+ Int
1, forall a. a -> Edit a
Del (Vector a
xs forall a. Vector a -> Int -> a
V.! (Int
n forall a. Num a => a -> a -> a
- Int
1)) forall a. a -> [a] -> [a]
: [Edit a]
edit)
impl Int
n Int
m = forall a. [a] -> a
head forall a b. (a -> b) -> a -> b
$ forall b a. Ord b => (a -> b) -> [a] -> [a]
sortOn forall a b. (a, b) -> a
fst
[ (Int, [Edit a])
edit
, forall a c b d. (a -> c) -> (b -> d) -> (a, b) -> (c, d)
bimap (forall a. Num a => a -> a -> a
+Int
1) (forall a. a -> Edit a
Ins a
y forall a. a -> [a] -> [a]
:) (Int -> Int -> (Int, [Edit a])
lcs Int
n (Int
m forall a. Num a => a -> a -> a
- Int
1))
, forall a c b d. (a -> c) -> (b -> d) -> (a, b) -> (c, d)
bimap (forall a. Num a => a -> a -> a
+Int
1) (forall a. a -> Edit a
Del a
x forall a. a -> [a] -> [a]
:) (Int -> Int -> (Int, [Edit a])
lcs (Int
n forall a. Num a => a -> a -> a
- Int
1) Int
m)
]
where
x :: a
x = Vector a
xs forall a. Vector a -> Int -> a
V.! (Int
n forall a. Num a => a -> a -> a
- Int
1)
y :: a
y = Vector a
ys forall a. Vector a -> Int -> a
V.! (Int
m forall a. Num a => a -> a -> a
- Int
1)
edit :: (Int, [Edit a])
edit
| a -> a -> Bool
eq a
x a
y = forall a c b d. (a -> c) -> (b -> d) -> (a, b) -> (c, d)
bimap forall a. a -> a
id (forall a. a -> Edit a
Cpy a
x forall a. a -> [a] -> [a]
:) (Int -> Int -> (Int, [Edit a])
lcs (Int
n forall a. Num a => a -> a -> a
- Int
1) (Int
m forall a. Num a => a -> a -> a
- Int
1))
| Bool
otherwise = forall a c b d. (a -> c) -> (b -> d) -> (a, b) -> (c, d)
bimap (forall a. Num a => a -> a -> a
+Int
1) (forall a. a -> a -> Edit a
Swp a
x a
y forall a. a -> [a] -> [a]
:) (Int -> Int -> (Int, [Edit a])
lcs (Int
n forall a. Num a => a -> a -> a
-Int
1 ) (Int
m forall a. Num a => a -> a -> a
- Int
1))
bimap :: (a -> c) -> (b -> d) -> (a, b) -> (c, d)
bimap :: forall a c b d. (a -> c) -> (b -> d) -> (a, b) -> (c, d)
bimap a -> c
f b -> d
g (a
x, b
y) = (a -> c
f a
x, b -> d
g b
y)