{-# LANGUAGE BangPatterns       #-}
{-# LANGUAGE CPP                #-}
{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE DeriveFunctor      #-}
{-# LANGUAGE ViewPatterns       #-}

-- | Implements \"patience diff\" and the patience algorithm for the longest
--   increasing subsequence problem.
module Patience
  ( -- * Patience diff
    diff
  , Item(..)
    -- * Longest increasing subsequence
  , longestIncreasing
  ) where

import           Data.Data       (Data)
import qualified Data.Foldable   as F
import qualified Data.IntMap     as IM
import           Data.List
import qualified Data.Map        as M
import qualified Data.Map.Strict as MS
import           Data.Ord
import           Data.Sequence   ( (<|), (|>), (><), ViewL(..), ViewR(..) )
import qualified Data.Sequence   as S
import           Data.Typeable   (Typeable)

-- If key xi is in the map, move it to xf while adjusting the value with f.
adjMove :: (a -> a) -> Int -> Int -> IM.IntMap a -> IM.IntMap a
adjMove :: forall a. (a -> a) -> Int -> Int -> IntMap a -> IntMap a
adjMove a -> a
f !Int
xi !Int
xf IntMap a
m = case (Int -> a -> Maybe a) -> Int -> IntMap a -> (Maybe a, IntMap a)
forall a.
(Int -> a -> Maybe a) -> Int -> IntMap a -> (Maybe a, IntMap a)
IM.updateLookupWithKey (\Int
_ a
_ -> Maybe a
forall a. Maybe a
Nothing) Int
xi IntMap a
m of
  (Just a
v, IntMap a
mm) -> Int -> a -> IntMap a -> IntMap a
forall a. Int -> a -> IntMap a -> IntMap a
IM.insert Int
xf (a -> a
f a
v) IntMap a
mm
  (Maybe a
Nothing, IntMap a
_) -> IntMap a
m

-- A "card" is an integer value (with annotation) plus a "backpointer" to
-- a card in the previous pile, if any.
data Card a = Card {-# UNPACK #-} !Int a (Maybe (Card a))

-- | Given: a list of distinct integers.  Picks a subset of the integers
--   in the same order, i.e. a subsequence, with the property that
--
--   * it is monotonically increasing, and
--
--   * it is at least as long as any other such subsequence.
--
-- This function uses patience sort:
-- <http://en.wikipedia.org/wiki/Patience_sorting>.
-- For implementation reasons, the actual list returned is the reverse of
-- the subsequence.
--
-- You can pair each integer with an arbitrary annotation, which will be
-- carried through the algorithm.
longestIncreasing :: [(Int,a)] -> [(Int,a)]
longestIncreasing :: forall a. [(Int, a)] -> [(Int, a)]
longestIncreasing = IntMap [Card a] -> [(Int, a)]
forall {b}. IntMap [Card b] -> [(Int, b)]
extract (IntMap [Card a] -> [(Int, a)])
-> ([(Int, a)] -> IntMap [Card a]) -> [(Int, a)] -> [(Int, a)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (IntMap [Card a] -> (Int, a) -> IntMap [Card a])
-> IntMap [Card a] -> [(Int, a)] -> IntMap [Card a]
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
F.foldl' IntMap [Card a] -> (Int, a) -> IntMap [Card a]
forall {b}. IntMap [Card b] -> (Int, b) -> IntMap [Card b]
ins IntMap [Card a]
forall a. IntMap a
IM.empty where
  -- Insert a card into the proper pile.
  -- type Pile  a = [Card a]
  -- type Piles a = IM.IntMap (Pile a)  -- keyed by smallest element
  ins :: IntMap [Card b] -> (Int, b) -> IntMap [Card b]
ins IntMap [Card b]
m (Int
x,b
a) =
    let (IntMap [Card b]
lt, IntMap [Card b]
gt) = Int -> IntMap [Card b] -> (IntMap [Card b], IntMap [Card b])
forall a. Int -> IntMap a -> (IntMap a, IntMap a)
IM.split Int
x IntMap [Card b]
m
        prev :: Maybe (Card b)
prev = ([Card b] -> Card b
forall a. HasCallStack => [a] -> a
head ([Card b] -> Card b)
-> (([Card b], IntMap [Card b]) -> [Card b])
-> ([Card b], IntMap [Card b])
-> Card b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([Card b], IntMap [Card b]) -> [Card b]
forall a b. (a, b) -> a
fst) (([Card b], IntMap [Card b]) -> Card b)
-> Maybe ([Card b], IntMap [Card b]) -> Maybe (Card b)
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` IntMap [Card b] -> Maybe ([Card b], IntMap [Card b])
forall a. IntMap a -> Maybe (a, IntMap a)
IM.maxView IntMap [Card b]
lt
        new :: Card b
new  = Int -> b -> Maybe (Card b) -> Card b
forall a. Int -> a -> Maybe (Card a) -> Card a
Card Int
x b
a Maybe (Card b)
prev
    in case IntMap [Card b] -> Maybe ((Int, [Card b]), IntMap [Card b])
forall a. IntMap a -> Maybe ((Int, a), IntMap a)
IM.minViewWithKey IntMap [Card b]
gt of
      Maybe ((Int, [Card b]), IntMap [Card b])
Nothing        -> Int -> [Card b] -> IntMap [Card b] -> IntMap [Card b]
forall a. Int -> a -> IntMap a -> IntMap a
IM.insert Int
x [Card b
new] IntMap [Card b]
m   -- new pile
      Just ((Int
k,[Card b]
_),IntMap [Card b]
_) -> ([Card b] -> [Card b])
-> Int -> Int -> IntMap [Card b] -> IntMap [Card b]
forall a. (a -> a) -> Int -> Int -> IntMap a -> IntMap a
adjMove (Card b
newCard b -> [Card b] -> [Card b]
forall a. a -> [a] -> [a]
:) Int
k Int
x IntMap [Card b]
m  -- top of old pile
  -- Walk the backpointers, starting at the top card of the
  -- highest-keyed pile.
  extract :: IntMap [Card b] -> [(Int, b)]
extract (IntMap [Card b] -> Maybe ([Card b], IntMap [Card b])
forall a. IntMap a -> Maybe (a, IntMap a)
IM.maxView -> Just ([Card b]
c,IntMap [Card b]
_)) = Card b -> [(Int, b)]
forall {b}. Card b -> [(Int, b)]
walk (Card b -> [(Int, b)]) -> Card b -> [(Int, b)]
forall a b. (a -> b) -> a -> b
$ [Card b] -> Card b
forall a. HasCallStack => [a] -> a
head [Card b]
c
  extract IntMap [Card b]
_ = []
  walk :: Card b -> [(Int, b)]
walk (Card Int
x b
a Maybe (Card b)
c) = (Int
x,b
a) (Int, b) -> [(Int, b)] -> [(Int, b)]
forall a. a -> [a] -> [a]
: [(Int, b)]
-> (Card b -> [(Int, b)]) -> Maybe (Card b) -> [(Int, b)]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] Card b -> [(Int, b)]
walk Maybe (Card b)
c

-- Elements whose second component appears exactly once.
unique :: (Ord k) => S.Seq (a,k) -> M.Map k a
unique :: forall k a. Ord k => Seq (a, k) -> Map k a
unique = (Maybe a -> Maybe a) -> Map k (Maybe a) -> Map k a
forall a b k. (a -> Maybe b) -> Map k a -> Map k b
M.mapMaybe Maybe a -> Maybe a
forall a. a -> a
id (Map k (Maybe a) -> Map k a)
-> (Seq (a, k) -> Map k (Maybe a)) -> Seq (a, k) -> Map k a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((a, k) -> Map k (Maybe a) -> Map k (Maybe a))
-> Map k (Maybe a) -> Seq (a, k) -> Map k (Maybe a)
forall a b. (a -> b -> b) -> b -> Seq a -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
F.foldr (a, k) -> Map k (Maybe a) -> Map k (Maybe a)
forall {k} {a}.
Ord k =>
(a, k) -> Map k (Maybe a) -> Map k (Maybe a)
ins Map k (Maybe a)
forall k a. Map k a
M.empty where
  ins :: (a, k) -> Map k (Maybe a) -> Map k (Maybe a)
ins (a
a,k
x) = (Maybe a -> Maybe a -> Maybe a)
-> k -> Maybe a -> Map k (Maybe a) -> Map k (Maybe a)
forall k a. Ord k => (a -> a -> a) -> k -> a -> Map k a -> Map k a
MS.insertWith (\Maybe a
_ Maybe a
_ -> Maybe a
forall a. Maybe a
Nothing) k
x (a -> Maybe a
forall a. a -> Maybe a
Just a
a)

-- Given two sequences of numbered "lines", returns a list of points
-- where unique lines match up.
solveLCS :: (Ord a) => S.Seq (Int,a) -> S.Seq (Int,a) -> [(Int,Int)]
solveLCS :: forall a. Ord a => Seq (Int, a) -> Seq (Int, a) -> [(Int, Int)]
solveLCS Seq (Int, a)
ma Seq (Int, a)
mb =
  let xs :: [(Int, Int)]
xs = Map a (Int, Int) -> [(Int, Int)]
forall k a. Map k a -> [a]
M.elems (Map a (Int, Int) -> [(Int, Int)])
-> Map a (Int, Int) -> [(Int, Int)]
forall a b. (a -> b) -> a -> b
$ (Int -> Int -> (Int, Int))
-> Map a Int -> Map a Int -> Map a (Int, Int)
forall k a b c.
Ord k =>
(a -> b -> c) -> Map k a -> Map k b -> Map k c
M.intersectionWith (,) (Seq (Int, a) -> Map a Int
forall k a. Ord k => Seq (a, k) -> Map k a
unique Seq (Int, a)
ma) (Seq (Int, a) -> Map a Int
forall k a. Ord k => Seq (a, k) -> Map k a
unique Seq (Int, a)
mb)
  in  [(Int, Int)] -> [(Int, Int)]
forall a. [(Int, a)] -> [(Int, a)]
longestIncreasing ([(Int, Int)] -> [(Int, Int)]) -> [(Int, Int)] -> [(Int, Int)]
forall a b. (a -> b) -> a -> b
$ ((Int, Int) -> (Int, Int) -> Ordering)
-> [(Int, Int)] -> [(Int, Int)]
forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy (((Int, Int) -> Int) -> (Int, Int) -> (Int, Int) -> Ordering
forall a b. Ord a => (b -> a) -> b -> b -> Ordering
comparing (Int, Int) -> Int
forall a b. (a, b) -> b
snd) [(Int, Int)]
xs

-- Type for decomposing a diff problem.  We either have two
-- lines that match, or a recursive subproblem.
data Piece a
  = Match a a
  | Diff (S.Seq a) (S.Seq a)
  deriving (Int -> Piece a -> ShowS
[Piece a] -> ShowS
Piece a -> String
(Int -> Piece a -> ShowS)
-> (Piece a -> String) -> ([Piece a] -> ShowS) -> Show (Piece a)
forall a. Show a => Int -> Piece a -> ShowS
forall a. Show a => [Piece a] -> ShowS
forall a. Show a => Piece a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall a. Show a => Int -> Piece a -> ShowS
showsPrec :: Int -> Piece a -> ShowS
$cshow :: forall a. Show a => Piece a -> String
show :: Piece a -> String
$cshowList :: forall a. Show a => [Piece a] -> ShowS
showList :: [Piece a] -> ShowS
Show)

-- Subdivides a diff problem according to the indices of matching lines.
chop :: S.Seq a -> S.Seq a -> [(Int,Int)] -> [Piece a]
chop :: forall a. Seq a -> Seq a -> [(Int, Int)] -> [Piece a]
chop Seq a
xs Seq a
ys []
  | Seq a -> Bool
forall a. Seq a -> Bool
S.null Seq a
xs Bool -> Bool -> Bool
&& Seq a -> Bool
forall a. Seq a -> Bool
S.null Seq a
ys = []
  | Bool
otherwise = [Seq a -> Seq a -> Piece a
forall a. Seq a -> Seq a -> Piece a
Diff Seq a
xs Seq a
ys]
chop Seq a
xs Seq a
ys (!(!Int
nx,!Int
ny):[(Int, Int)]
ns) =
  let (Seq a
xsr, Seq a -> ViewL a
forall a. Seq a -> ViewL a
S.viewl -> (a
x :< Seq a
xse)) = Int -> Seq a -> (Seq a, Seq a)
forall a. Int -> Seq a -> (Seq a, Seq a)
S.splitAt Int
nx Seq a
xs
      (Seq a
ysr, Seq a -> ViewL a
forall a. Seq a -> ViewL a
S.viewl -> (a
y :< Seq a
yse)) = Int -> Seq a -> (Seq a, Seq a)
forall a. Int -> Seq a -> (Seq a, Seq a)
S.splitAt Int
ny Seq a
ys
  in  Seq a -> Seq a -> Piece a
forall a. Seq a -> Seq a -> Piece a
Diff Seq a
xse Seq a
yse Piece a -> [Piece a] -> [Piece a]
forall a. a -> [a] -> [a]
: a -> a -> Piece a
forall a. a -> a -> Piece a
Match a
x a
y Piece a -> [Piece a] -> [Piece a]
forall a. a -> [a] -> [a]
: Seq a -> Seq a -> [(Int, Int)] -> [Piece a]
forall a. Seq a -> Seq a -> [(Int, Int)] -> [Piece a]
chop Seq a
xsr Seq a
ysr [(Int, Int)]
ns

-- Zip a list with a Seq.
zipLS :: [a] -> S.Seq b -> S.Seq (a, b)
zipLS :: forall a b. [a] -> Seq b -> Seq (a, b)
zipLS = Seq a -> Seq b -> Seq (a, b)
forall a b. Seq a -> Seq b -> Seq (a, b)
S.zip (Seq a -> Seq b -> Seq (a, b))
-> ([a] -> Seq a) -> [a] -> Seq b -> Seq (a, b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [a] -> Seq a
forall a. [a] -> Seq a
S.fromList

-- Number the elements of a Seq.
number :: S.Seq a -> S.Seq (Int,a)
number :: forall a. Seq a -> Seq (Int, a)
number Seq a
xs = [Int] -> Seq a -> Seq (Int, a)
forall a b. [a] -> Seq b -> Seq (a, b)
zipLS [Int
0..Seq a -> Int
forall a. Seq a -> Int
S.length Seq a
xs Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1] Seq a
xs

-- | An element of a computed difference.
data Item a
  = Old  a    -- ^ Value taken from the \"old\" list, i.e. left argument to 'diff'
  | New  a    -- ^ Value taken from the \"new\" list, i.e. right argument to 'diff'
  | Both a a  -- ^ Value taken from both lists.  Both values are provided, in case
              --   your type has a non-structural definition of equality.
  deriving (Item a -> Item a -> Bool
(Item a -> Item a -> Bool)
-> (Item a -> Item a -> Bool) -> Eq (Item a)
forall a. Eq a => Item a -> Item a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall a. Eq a => Item a -> Item a -> Bool
== :: Item a -> Item a -> Bool
$c/= :: forall a. Eq a => Item a -> Item a -> Bool
/= :: Item a -> Item a -> Bool
Eq, Eq (Item a)
Eq (Item a) =>
(Item a -> Item a -> Ordering)
-> (Item a -> Item a -> Bool)
-> (Item a -> Item a -> Bool)
-> (Item a -> Item a -> Bool)
-> (Item a -> Item a -> Bool)
-> (Item a -> Item a -> Item a)
-> (Item a -> Item a -> Item a)
-> Ord (Item a)
Item a -> Item a -> Bool
Item a -> Item a -> Ordering
Item a -> Item a -> Item a
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
forall a. Ord a => Eq (Item a)
forall a. Ord a => Item a -> Item a -> Bool
forall a. Ord a => Item a -> Item a -> Ordering
forall a. Ord a => Item a -> Item a -> Item a
$ccompare :: forall a. Ord a => Item a -> Item a -> Ordering
compare :: Item a -> Item a -> Ordering
$c< :: forall a. Ord a => Item a -> Item a -> Bool
< :: Item a -> Item a -> Bool
$c<= :: forall a. Ord a => Item a -> Item a -> Bool
<= :: Item a -> Item a -> Bool
$c> :: forall a. Ord a => Item a -> Item a -> Bool
> :: Item a -> Item a -> Bool
$c>= :: forall a. Ord a => Item a -> Item a -> Bool
>= :: Item a -> Item a -> Bool
$cmax :: forall a. Ord a => Item a -> Item a -> Item a
max :: Item a -> Item a -> Item a
$cmin :: forall a. Ord a => Item a -> Item a -> Item a
min :: Item a -> Item a -> Item a
Ord, Int -> Item a -> ShowS
[Item a] -> ShowS
Item a -> String
(Int -> Item a -> ShowS)
-> (Item a -> String) -> ([Item a] -> ShowS) -> Show (Item a)
forall a. Show a => Int -> Item a -> ShowS
forall a. Show a => [Item a] -> ShowS
forall a. Show a => Item a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall a. Show a => Int -> Item a -> ShowS
showsPrec :: Int -> Item a -> ShowS
$cshow :: forall a. Show a => Item a -> String
show :: Item a -> String
$cshowList :: forall a. Show a => [Item a] -> ShowS
showList :: [Item a] -> ShowS
Show, ReadPrec [Item a]
ReadPrec (Item a)
Int -> ReadS (Item a)
ReadS [Item a]
(Int -> ReadS (Item a))
-> ReadS [Item a]
-> ReadPrec (Item a)
-> ReadPrec [Item a]
-> Read (Item a)
forall a. Read a => ReadPrec [Item a]
forall a. Read a => ReadPrec (Item a)
forall a. Read a => Int -> ReadS (Item a)
forall a. Read a => ReadS [Item a]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: forall a. Read a => Int -> ReadS (Item a)
readsPrec :: Int -> ReadS (Item a)
$creadList :: forall a. Read a => ReadS [Item a]
readList :: ReadS [Item a]
$creadPrec :: forall a. Read a => ReadPrec (Item a)
readPrec :: ReadPrec (Item a)
$creadListPrec :: forall a. Read a => ReadPrec [Item a]
readListPrec :: ReadPrec [Item a]
Read, Typeable, Typeable (Item a)
Typeable (Item a) =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> Item a -> c (Item a))
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c (Item a))
-> (Item a -> Constr)
-> (Item a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c (Item a)))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c (Item a)))
-> ((forall b. Data b => b -> b) -> Item a -> Item a)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> Item a -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> Item a -> r)
-> (forall u. (forall d. Data d => d -> u) -> Item a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> Item a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> Item a -> m (Item a))
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Item a -> m (Item a))
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Item a -> m (Item a))
-> Data (Item a)
Item a -> Constr
Item a -> DataType
(forall b. Data b => b -> b) -> Item a -> Item a
forall a. Data a => Typeable (Item a)
forall a. Data a => Item a -> Constr
forall a. Data a => Item a -> DataType
forall a.
Data a =>
(forall b. Data b => b -> b) -> Item a -> Item a
forall a u.
Data a =>
Int -> (forall d. Data d => d -> u) -> Item a -> u
forall a u. Data a => (forall d. Data d => d -> u) -> Item a -> [u]
forall a r r'.
Data a =>
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Item a -> r
forall a r r'.
Data a =>
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Item a -> r
forall a (m :: * -> *).
(Data a, Monad m) =>
(forall d. Data d => d -> m d) -> Item a -> m (Item a)
forall a (m :: * -> *).
(Data a, MonadPlus m) =>
(forall d. Data d => d -> m d) -> Item a -> m (Item a)
forall a (c :: * -> *).
Data a =>
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (Item a)
forall a (c :: * -> *).
Data a =>
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Item a -> c (Item a)
forall a (t :: * -> *) (c :: * -> *).
(Data a, Typeable t) =>
(forall d. Data d => c (t d)) -> Maybe (c (Item a))
forall a (t :: * -> * -> *) (c :: * -> *).
(Data a, Typeable t) =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c (Item a))
forall a.
Typeable a =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> Item a -> u
forall u. (forall d. Data d => d -> u) -> Item a -> [u]
forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Item a -> r
forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Item a -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Item a -> m (Item a)
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Item a -> m (Item a)
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (Item a)
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Item a -> c (Item a)
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c (Item a))
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c (Item a))
$cgfoldl :: forall a (c :: * -> *).
Data a =>
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Item a -> c (Item a)
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Item a -> c (Item a)
$cgunfold :: forall a (c :: * -> *).
Data a =>
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (Item a)
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (Item a)
$ctoConstr :: forall a. Data a => Item a -> Constr
toConstr :: Item a -> Constr
$cdataTypeOf :: forall a. Data a => Item a -> DataType
dataTypeOf :: Item a -> DataType
$cdataCast1 :: forall a (t :: * -> *) (c :: * -> *).
(Data a, Typeable t) =>
(forall d. Data d => c (t d)) -> Maybe (c (Item a))
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c (Item a))
$cdataCast2 :: forall a (t :: * -> * -> *) (c :: * -> *).
(Data a, Typeable t) =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c (Item a))
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c (Item a))
$cgmapT :: forall a.
Data a =>
(forall b. Data b => b -> b) -> Item a -> Item a
gmapT :: (forall b. Data b => b -> b) -> Item a -> Item a
$cgmapQl :: forall a r r'.
Data a =>
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Item a -> r
gmapQl :: forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Item a -> r
$cgmapQr :: forall a r r'.
Data a =>
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Item a -> r
gmapQr :: forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Item a -> r
$cgmapQ :: forall a u. Data a => (forall d. Data d => d -> u) -> Item a -> [u]
gmapQ :: forall u. (forall d. Data d => d -> u) -> Item a -> [u]
$cgmapQi :: forall a u.
Data a =>
Int -> (forall d. Data d => d -> u) -> Item a -> u
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Item a -> u
$cgmapM :: forall a (m :: * -> *).
(Data a, Monad m) =>
(forall d. Data d => d -> m d) -> Item a -> m (Item a)
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Item a -> m (Item a)
$cgmapMp :: forall a (m :: * -> *).
(Data a, MonadPlus m) =>
(forall d. Data d => d -> m d) -> Item a -> m (Item a)
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Item a -> m (Item a)
$cgmapMo :: forall a (m :: * -> *).
(Data a, MonadPlus m) =>
(forall d. Data d => d -> m d) -> Item a -> m (Item a)
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Item a -> m (Item a)
Data, (forall a b. (a -> b) -> Item a -> Item b)
-> (forall a b. a -> Item b -> Item a) -> Functor Item
forall a b. a -> Item b -> Item a
forall a b. (a -> b) -> Item a -> Item b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
$cfmap :: forall a b. (a -> b) -> Item a -> Item b
fmap :: forall a b. (a -> b) -> Item a -> Item b
$c<$ :: forall a b. a -> Item b -> Item a
<$ :: forall a b. a -> Item b -> Item a
Functor)

-- | The difference between two lists, according to the
-- \"patience diff\" algorithm.
diff :: (Ord a) => [a] -> [a] -> [Item a]
diff :: forall a. Ord a => [a] -> [a] -> [Item a]
diff [a]
xsl [a]
ysl = Seq (Item a) -> [Item a]
forall a. Seq a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
F.toList (Seq (Item a) -> [Item a]) -> Seq (Item a) -> [Item a]
forall a b. (a -> b) -> a -> b
$ Seq a -> Seq a -> Seq (Item a)
forall {a}. Ord a => Seq a -> Seq a -> Seq (Item a)
go ([a] -> Seq a
forall a. [a] -> Seq a
S.fromList [a]
xsl) ([a] -> Seq a
forall a. [a] -> Seq a
S.fromList [a]
ysl) where
  -- Handle common elements at the beginning / end.
  go :: Seq a -> Seq a -> Seq (Item a)
go (Seq a -> ViewL a
forall a. Seq a -> ViewL a
S.viewl -> (a
x :< Seq a
xs)) (Seq a -> ViewL a
forall a. Seq a -> ViewL a
S.viewl -> (a
y :< Seq a
ys))
    | a
x a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
y = a -> a -> Item a
forall a. a -> a -> Item a
Both a
x a
y Item a -> Seq (Item a) -> Seq (Item a)
forall a. a -> Seq a -> Seq a
<| Seq a -> Seq a -> Seq (Item a)
go Seq a
xs Seq a
ys
  go (Seq a -> ViewR a
forall a. Seq a -> ViewR a
S.viewr -> (Seq a
xs :> a
x)) (Seq a -> ViewR a
forall a. Seq a -> ViewR a
S.viewr -> (Seq a
ys :> a
y))
    | a
x a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
y = Seq a -> Seq a -> Seq (Item a)
go Seq a
xs Seq a
ys Seq (Item a) -> Item a -> Seq (Item a)
forall a. Seq a -> a -> Seq a
|> a -> a -> Item a
forall a. a -> a -> Item a
Both a
x a
y
  -- Find an increasing sequence of matching unique lines, then
  -- subdivide at those points and recurse.
  go Seq a
xs Seq a
ys = case Seq a -> Seq a -> [(Int, Int)] -> [Piece a]
forall a. Seq a -> Seq a -> [(Int, Int)] -> [Piece a]
chop Seq a
xs Seq a
ys ([(Int, Int)] -> [Piece a]) -> [(Int, Int)] -> [Piece a]
forall a b. (a -> b) -> a -> b
$ Seq (Int, a) -> Seq (Int, a) -> [(Int, Int)]
forall a. Ord a => Seq (Int, a) -> Seq (Int, a) -> [(Int, Int)]
solveLCS (Seq a -> Seq (Int, a)
forall a. Seq a -> Seq (Int, a)
number Seq a
xs) (Seq a -> Seq (Int, a)
forall a. Seq a -> Seq (Int, a)
number Seq a
ys) of
    -- If we fail to subdivide, just record the chunk as is.
    [Diff Seq a
_ Seq a
_] -> (a -> Item a) -> Seq a -> Seq (Item a)
forall a b. (a -> b) -> Seq a -> Seq b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> Item a
forall a. a -> Item a
Old Seq a
xs Seq (Item a) -> Seq (Item a) -> Seq (Item a)
forall a. Seq a -> Seq a -> Seq a
>< (a -> Item a) -> Seq a -> Seq (Item a)
forall a b. (a -> b) -> Seq a -> Seq b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> Item a
forall a. a -> Item a
New Seq a
ys
    [Piece a]
ps -> [Piece a] -> Seq (Item a)
recur [Piece a]
ps

  -- Apply the algorithm recursively to a decomposed problem.
  -- The decomposition list is in reversed order.
  recur :: [Piece a] -> Seq (Item a)
recur [] = Seq (Item a)
forall a. Seq a
S.empty
  recur (Match a
x a
y  : [Piece a]
ps) = [Piece a] -> Seq (Item a)
recur [Piece a]
ps Seq (Item a) -> Item a -> Seq (Item a)
forall a. Seq a -> a -> Seq a
|> a -> a -> Item a
forall a. a -> a -> Item a
Both a
x a
y
  recur (Diff Seq a
xs Seq a
ys : [Piece a]
ps) = [Piece a] -> Seq (Item a)
recur [Piece a]
ps Seq (Item a) -> Seq (Item a) -> Seq (Item a)
forall a. Seq a -> Seq a -> Seq a
>< Seq a -> Seq a -> Seq (Item a)
go Seq a
xs Seq a
ys