{-# LANGUAGE DeriveDataTypeable, DeriveGeneric, DeriveTraversable, Safe, TemplateHaskellQuotes #-}

{-|
Module      : Dep.Algorithm.Levenshtein
Description : A module to determine the edit distance between two sequences.
Maintainer  : hapytexeu+gh@gmail.com
Stability   : experimental
Portability : POSIX

This module exports functions to help determine how different two sequences are.
This is used to guess the name of the command if the command given by the user
does not map on an action.
-}

module Dep.Algorithm.Levenshtein (
    -- * Present edits to a sequence
    Edit(Add, Rem, Copy, Swap)
    -- * Edit distance score
  , editScore, editScore'
    -- * Determine the most optimal edit
  , levenshtein, levenshtein', reversedLevenshtein, reversedLevenshtein'
    -- * Advanced Levenshtein distances
  , genericReversedLevenshtein, genericReversedLevenshtein'
  ) where

import Control.Arrow(second)
import Control.DeepSeq(NFData, NFData1)

import Data.Binary(Binary(put, get), getWord8, putWord8)
import Data.Data(Data)
import Data.Functor.Classes(Eq1(liftEq), Ord1(liftCompare))
import Data.Hashable(Hashable)
import Data.Hashable.Lifted(Hashable1)

import Dep.Utils(applyExp')

import GHC.Generics(Generic, Generic1)

import Language.Haskell.TH.Syntax(Lift(lift, liftTyped), TExp(TExp))

import Test.QuickCheck(oneof)
import Test.QuickCheck.Arbitrary(Arbitrary(arbitrary, shrink), Arbitrary1(liftArbitrary), arbitrary1)

-- | A data type that is used to list how to edit a sequence to form another sequence.
data Edit a
  = Add a  -- ^ We add the given element to the sequence.
  | Rem a  -- ^ We remove the given element to the sequence.
  | Copy a  -- ^ We copy an element from the sequence, this basically act as a /no-op/.
  | Swap a a  -- ^ We modify the given first item into the second item, this thus denotes a replacement.
  deriving (Typeable (Edit a)
DataType
Constr
Typeable (Edit a)
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> Edit a -> c (Edit a))
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c (Edit a))
-> (Edit a -> Constr)
-> (Edit a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c (Edit a)))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c (Edit a)))
-> ((forall b. Data b => b -> b) -> Edit a -> Edit a)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> Edit a -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> Edit a -> r)
-> (forall u. (forall d. Data d => d -> u) -> Edit a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> Edit a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> Edit a -> m (Edit a))
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Edit a -> m (Edit a))
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Edit a -> m (Edit a))
-> Data (Edit a)
Edit a -> DataType
Edit a -> Constr
(forall d. Data d => c (t d)) -> Maybe (c (Edit a))
(forall b. Data b => b -> b) -> Edit a -> Edit a
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Edit a -> c (Edit a)
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (Edit a)
forall a. Data a => Typeable (Edit a)
forall a. Data a => Edit a -> DataType
forall a. Data a => Edit a -> Constr
forall a.
Data a =>
(forall b. Data b => b -> b) -> Edit a -> Edit a
forall a u.
Data a =>
Int -> (forall d. Data d => d -> u) -> Edit a -> u
forall a u. Data a => (forall d. Data d => d -> u) -> Edit a -> [u]
forall a r r'.
Data a =>
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Edit a -> r
forall a r r'.
Data a =>
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Edit a -> r
forall a (m :: * -> *).
(Data a, Monad m) =>
(forall d. Data d => d -> m d) -> Edit a -> m (Edit a)
forall a (m :: * -> *).
(Data a, MonadPlus m) =>
(forall d. Data d => d -> m d) -> Edit a -> m (Edit a)
forall a (c :: * -> *).
Data a =>
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (Edit a)
forall a (c :: * -> *).
Data a =>
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Edit a -> c (Edit a)
forall a (t :: * -> *) (c :: * -> *).
(Data a, Typeable t) =>
(forall d. Data d => c (t d)) -> Maybe (c (Edit a))
forall a (t :: * -> * -> *) (c :: * -> *).
(Data a, Typeable t) =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c (Edit 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) -> Edit a -> u
forall u. (forall d. Data d => d -> u) -> Edit a -> [u]
forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Edit a -> r
forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Edit a -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Edit a -> m (Edit a)
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Edit a -> m (Edit a)
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (Edit a)
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Edit a -> c (Edit a)
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c (Edit a))
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c (Edit a))
$cSwap :: Constr
$cCopy :: Constr
$cRem :: Constr
$cAdd :: Constr
$tEdit :: DataType
gmapMo :: (forall d. Data d => d -> m d) -> Edit a -> m (Edit a)
$cgmapMo :: forall a (m :: * -> *).
(Data a, MonadPlus m) =>
(forall d. Data d => d -> m d) -> Edit a -> m (Edit a)
gmapMp :: (forall d. Data d => d -> m d) -> Edit a -> m (Edit a)
$cgmapMp :: forall a (m :: * -> *).
(Data a, MonadPlus m) =>
(forall d. Data d => d -> m d) -> Edit a -> m (Edit a)
gmapM :: (forall d. Data d => d -> m d) -> Edit a -> m (Edit a)
$cgmapM :: forall a (m :: * -> *).
(Data a, Monad m) =>
(forall d. Data d => d -> m d) -> Edit a -> m (Edit a)
gmapQi :: Int -> (forall d. Data d => d -> u) -> Edit a -> u
$cgmapQi :: forall a u.
Data a =>
Int -> (forall d. Data d => d -> u) -> Edit a -> u
gmapQ :: (forall d. Data d => d -> u) -> Edit a -> [u]
$cgmapQ :: forall a u. Data a => (forall d. Data d => d -> u) -> Edit a -> [u]
gmapQr :: (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Edit a -> r
$cgmapQr :: forall a r r'.
Data a =>
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Edit a -> r
gmapQl :: (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Edit a -> r
$cgmapQl :: forall a r r'.
Data a =>
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Edit a -> r
gmapT :: (forall b. Data b => b -> b) -> Edit a -> Edit a
$cgmapT :: forall a.
Data a =>
(forall b. Data b => b -> b) -> Edit a -> Edit a
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c (Edit a))
$cdataCast2 :: forall a (t :: * -> * -> *) (c :: * -> *).
(Data a, Typeable t) =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c (Edit a))
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c (Edit a))
$cdataCast1 :: forall a (t :: * -> *) (c :: * -> *).
(Data a, Typeable t) =>
(forall d. Data d => c (t d)) -> Maybe (c (Edit a))
dataTypeOf :: Edit a -> DataType
$cdataTypeOf :: forall a. Data a => Edit a -> DataType
toConstr :: Edit a -> Constr
$ctoConstr :: forall a. Data a => Edit a -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (Edit a)
$cgunfold :: forall a (c :: * -> *).
Data a =>
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (Edit a)
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Edit a -> c (Edit a)
$cgfoldl :: forall a (c :: * -> *).
Data a =>
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Edit a -> c (Edit a)
$cp1Data :: forall a. Data a => Typeable (Edit a)
Data, Edit a -> Edit a -> Bool
(Edit a -> Edit a -> Bool)
-> (Edit a -> Edit a -> Bool) -> Eq (Edit a)
forall a. Eq a => Edit a -> Edit a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Edit a -> Edit a -> Bool
$c/= :: forall a. Eq a => Edit a -> Edit a -> Bool
== :: Edit a -> Edit a -> Bool
$c== :: forall a. Eq a => Edit a -> Edit a -> Bool
Eq, Edit a -> Bool
(a -> m) -> Edit a -> m
(a -> b -> b) -> b -> Edit a -> b
(forall m. Monoid m => Edit m -> m)
-> (forall m a. Monoid m => (a -> m) -> Edit a -> m)
-> (forall m a. Monoid m => (a -> m) -> Edit a -> m)
-> (forall a b. (a -> b -> b) -> b -> Edit a -> b)
-> (forall a b. (a -> b -> b) -> b -> Edit a -> b)
-> (forall b a. (b -> a -> b) -> b -> Edit a -> b)
-> (forall b a. (b -> a -> b) -> b -> Edit a -> b)
-> (forall a. (a -> a -> a) -> Edit a -> a)
-> (forall a. (a -> a -> a) -> Edit a -> a)
-> (forall a. Edit a -> [a])
-> (forall a. Edit a -> Bool)
-> (forall a. Edit a -> Int)
-> (forall a. Eq a => a -> Edit a -> Bool)
-> (forall a. Ord a => Edit a -> a)
-> (forall a. Ord a => Edit a -> a)
-> (forall a. Num a => Edit a -> a)
-> (forall a. Num a => Edit a -> a)
-> Foldable Edit
forall a. Eq a => a -> Edit a -> Bool
forall a. Num a => Edit a -> a
forall a. Ord a => Edit a -> a
forall m. Monoid m => Edit m -> m
forall a. Edit a -> Bool
forall a. Edit a -> Int
forall a. Edit a -> [a]
forall a. (a -> a -> a) -> Edit a -> a
forall m a. Monoid m => (a -> m) -> Edit a -> m
forall b a. (b -> a -> b) -> b -> Edit a -> b
forall a b. (a -> b -> b) -> b -> Edit a -> b
forall (t :: * -> *).
(forall m. Monoid m => t m -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. t a -> [a])
-> (forall a. t a -> Bool)
-> (forall a. t a -> Int)
-> (forall a. Eq a => a -> t a -> Bool)
-> (forall a. Ord a => t a -> a)
-> (forall a. Ord a => t a -> a)
-> (forall a. Num a => t a -> a)
-> (forall a. Num a => t a -> a)
-> Foldable t
product :: Edit a -> a
$cproduct :: forall a. Num a => Edit a -> a
sum :: Edit a -> a
$csum :: forall a. Num a => Edit a -> a
minimum :: Edit a -> a
$cminimum :: forall a. Ord a => Edit a -> a
maximum :: Edit a -> a
$cmaximum :: forall a. Ord a => Edit a -> a
elem :: a -> Edit a -> Bool
$celem :: forall a. Eq a => a -> Edit a -> Bool
length :: Edit a -> Int
$clength :: forall a. Edit a -> Int
null :: Edit a -> Bool
$cnull :: forall a. Edit a -> Bool
toList :: Edit a -> [a]
$ctoList :: forall a. Edit a -> [a]
foldl1 :: (a -> a -> a) -> Edit a -> a
$cfoldl1 :: forall a. (a -> a -> a) -> Edit a -> a
foldr1 :: (a -> a -> a) -> Edit a -> a
$cfoldr1 :: forall a. (a -> a -> a) -> Edit a -> a
foldl' :: (b -> a -> b) -> b -> Edit a -> b
$cfoldl' :: forall b a. (b -> a -> b) -> b -> Edit a -> b
foldl :: (b -> a -> b) -> b -> Edit a -> b
$cfoldl :: forall b a. (b -> a -> b) -> b -> Edit a -> b
foldr' :: (a -> b -> b) -> b -> Edit a -> b
$cfoldr' :: forall a b. (a -> b -> b) -> b -> Edit a -> b
foldr :: (a -> b -> b) -> b -> Edit a -> b
$cfoldr :: forall a b. (a -> b -> b) -> b -> Edit a -> b
foldMap' :: (a -> m) -> Edit a -> m
$cfoldMap' :: forall m a. Monoid m => (a -> m) -> Edit a -> m
foldMap :: (a -> m) -> Edit a -> m
$cfoldMap :: forall m a. Monoid m => (a -> m) -> Edit a -> m
fold :: Edit m -> m
$cfold :: forall m. Monoid m => Edit m -> m
Foldable, a -> Edit b -> Edit a
(a -> b) -> Edit a -> Edit b
(forall a b. (a -> b) -> Edit a -> Edit b)
-> (forall a b. a -> Edit b -> Edit a) -> Functor Edit
forall a b. a -> Edit b -> Edit a
forall a b. (a -> b) -> Edit a -> Edit b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> Edit b -> Edit a
$c<$ :: forall a b. a -> Edit b -> Edit a
fmap :: (a -> b) -> Edit a -> Edit b
$cfmap :: forall a b. (a -> b) -> Edit a -> Edit b
Functor, (forall x. Edit a -> Rep (Edit a) x)
-> (forall x. Rep (Edit a) x -> Edit a) -> Generic (Edit a)
forall x. Rep (Edit a) x -> Edit a
forall x. Edit a -> Rep (Edit a) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall a x. Rep (Edit a) x -> Edit a
forall a x. Edit a -> Rep (Edit a) x
$cto :: forall a x. Rep (Edit a) x -> Edit a
$cfrom :: forall a x. Edit a -> Rep (Edit a) x
Generic, (forall a. Edit a -> Rep1 Edit a)
-> (forall a. Rep1 Edit a -> Edit a) -> Generic1 Edit
forall a. Rep1 Edit a -> Edit a
forall a. Edit a -> Rep1 Edit a
forall k (f :: k -> *).
(forall (a :: k). f a -> Rep1 f a)
-> (forall (a :: k). Rep1 f a -> f a) -> Generic1 f
$cto1 :: forall a. Rep1 Edit a -> Edit a
$cfrom1 :: forall a. Edit a -> Rep1 Edit a
Generic1, Eq (Edit a)
Eq (Edit a)
-> (Edit a -> Edit a -> Ordering)
-> (Edit a -> Edit a -> Bool)
-> (Edit a -> Edit a -> Bool)
-> (Edit a -> Edit a -> Bool)
-> (Edit a -> Edit a -> Bool)
-> (Edit a -> Edit a -> Edit a)
-> (Edit a -> Edit a -> Edit a)
-> Ord (Edit a)
Edit a -> Edit a -> Bool
Edit a -> Edit a -> Ordering
Edit a -> Edit a -> Edit 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 (Edit a)
forall a. Ord a => Edit a -> Edit a -> Bool
forall a. Ord a => Edit a -> Edit a -> Ordering
forall a. Ord a => Edit a -> Edit a -> Edit a
min :: Edit a -> Edit a -> Edit a
$cmin :: forall a. Ord a => Edit a -> Edit a -> Edit a
max :: Edit a -> Edit a -> Edit a
$cmax :: forall a. Ord a => Edit a -> Edit a -> Edit a
>= :: Edit a -> Edit a -> Bool
$c>= :: forall a. Ord a => Edit a -> Edit a -> Bool
> :: Edit a -> Edit a -> Bool
$c> :: forall a. Ord a => Edit a -> Edit a -> Bool
<= :: Edit a -> Edit a -> Bool
$c<= :: forall a. Ord a => Edit a -> Edit a -> Bool
< :: Edit a -> Edit a -> Bool
$c< :: forall a. Ord a => Edit a -> Edit a -> Bool
compare :: Edit a -> Edit a -> Ordering
$ccompare :: forall a. Ord a => Edit a -> Edit a -> Ordering
$cp1Ord :: forall a. Ord a => Eq (Edit a)
Ord, ReadPrec [Edit a]
ReadPrec (Edit a)
Int -> ReadS (Edit a)
ReadS [Edit a]
(Int -> ReadS (Edit a))
-> ReadS [Edit a]
-> ReadPrec (Edit a)
-> ReadPrec [Edit a]
-> Read (Edit a)
forall a. Read a => ReadPrec [Edit a]
forall a. Read a => ReadPrec (Edit a)
forall a. Read a => Int -> ReadS (Edit a)
forall a. Read a => ReadS [Edit a]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Edit a]
$creadListPrec :: forall a. Read a => ReadPrec [Edit a]
readPrec :: ReadPrec (Edit a)
$creadPrec :: forall a. Read a => ReadPrec (Edit a)
readList :: ReadS [Edit a]
$creadList :: forall a. Read a => ReadS [Edit a]
readsPrec :: Int -> ReadS (Edit a)
$creadsPrec :: forall a. Read a => Int -> ReadS (Edit a)
Read, Int -> Edit a -> ShowS
[Edit a] -> ShowS
Edit a -> String
(Int -> Edit a -> ShowS)
-> (Edit a -> String) -> ([Edit a] -> ShowS) -> Show (Edit a)
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, Functor Edit
Foldable Edit
Functor Edit
-> Foldable Edit
-> (forall (f :: * -> *) a b.
    Applicative f =>
    (a -> f b) -> Edit a -> f (Edit b))
-> (forall (f :: * -> *) a.
    Applicative f =>
    Edit (f a) -> f (Edit a))
-> (forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> Edit a -> m (Edit b))
-> (forall (m :: * -> *) a. Monad m => Edit (m a) -> m (Edit a))
-> Traversable Edit
(a -> f b) -> Edit a -> f (Edit b)
forall (t :: * -> *).
Functor t
-> Foldable t
-> (forall (f :: * -> *) a b.
    Applicative f =>
    (a -> f b) -> t a -> f (t b))
-> (forall (f :: * -> *) a. Applicative f => t (f a) -> f (t a))
-> (forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> t a -> m (t b))
-> (forall (m :: * -> *) a. Monad m => t (m a) -> m (t a))
-> Traversable t
forall (m :: * -> *) a. Monad m => Edit (m a) -> m (Edit a)
forall (f :: * -> *) a. Applicative f => Edit (f a) -> f (Edit a)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Edit a -> m (Edit b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Edit a -> f (Edit b)
sequence :: Edit (m a) -> m (Edit a)
$csequence :: forall (m :: * -> *) a. Monad m => Edit (m a) -> m (Edit a)
mapM :: (a -> m b) -> Edit a -> m (Edit b)
$cmapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Edit a -> m (Edit b)
sequenceA :: Edit (f a) -> f (Edit a)
$csequenceA :: forall (f :: * -> *) a. Applicative f => Edit (f a) -> f (Edit a)
traverse :: (a -> f b) -> Edit a -> f (Edit b)
$ctraverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Edit a -> f (Edit b)
$cp2Traversable :: Foldable Edit
$cp1Traversable :: Functor Edit
Traversable)

instance Arbitrary1 Edit where
    liftArbitrary :: Gen a -> Gen (Edit a)
liftArbitrary Gen a
arb = Gen (Edit a)
go
      where go :: Gen (Edit a)
go = [Gen (Edit a)] -> Gen (Edit a)
forall a. [Gen a] -> Gen a
oneof [a -> Edit a
forall a. a -> Edit a
Add (a -> Edit a) -> Gen a -> Gen (Edit a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen a
arb, a -> Edit a
forall a. a -> Edit a
Rem (a -> Edit a) -> Gen a -> Gen (Edit a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen a
arb, a -> Edit a
forall a. a -> Edit a
Copy (a -> Edit a) -> Gen a -> Gen (Edit a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen a
arb, a -> a -> Edit a
forall a. a -> a -> Edit a
Swap (a -> a -> Edit a) -> Gen a -> Gen (a -> Edit a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen a
arb Gen (a -> Edit a) -> Gen a -> Gen (Edit a)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen a
arb]

instance Arbitrary a => Arbitrary (Edit a) where
    arbitrary :: Gen (Edit a)
arbitrary = Gen (Edit a)
forall (f :: * -> *) a. (Arbitrary1 f, Arbitrary a) => Gen (f a)
arbitrary1
    shrink :: Edit a -> [Edit a]
shrink (Add a
x) = a -> Edit a
forall a. a -> Edit a
Add (a -> Edit a) -> [a] -> [Edit a]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> a -> [a]
forall a. Arbitrary a => a -> [a]
shrink a
x
    shrink (Rem a
x) = a -> Edit a
forall a. a -> Edit a
Rem (a -> Edit a) -> [a] -> [Edit a]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> a -> [a]
forall a. Arbitrary a => a -> [a]
shrink a
x
    shrink (Copy a
x) = a -> Edit a
forall a. a -> Edit a
Copy (a -> Edit a) -> [a] -> [Edit a]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> a -> [a]
forall a. Arbitrary a => a -> [a]
shrink a
x
    shrink (Swap a
x a
y) = a -> a -> Edit a
forall a. a -> a -> Edit a
Swap (a -> a -> Edit a) -> [a] -> [a -> Edit a]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> a -> [a]
forall a. Arbitrary a => a -> [a]
shrink a
x [a -> Edit a] -> [a] -> [Edit a]
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> a -> [a]
forall a. Arbitrary a => a -> [a]
shrink a
y

instance Binary a => Binary (Edit a) where
    put :: Edit a -> Put
put (Add a
x) = Word8 -> Put
putWord8 Word8
0 Put -> Put -> Put
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> a -> Put
forall t. Binary t => t -> Put
put a
x
    put (Rem a
x) = Word8 -> Put
putWord8 Word8
1 Put -> Put -> Put
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> a -> Put
forall t. Binary t => t -> Put
put a
x
    put (Copy a
x) = Word8 -> Put
putWord8 Word8
2 Put -> Put -> Put
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> a -> Put
forall t. Binary t => t -> Put
put a
x
    put (Swap a
x a
y) = Word8 -> Put
putWord8 Word8
3 Put -> Put -> Put
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> a -> Put
forall t. Binary t => t -> Put
put a
x Put -> Put -> Put
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> a -> Put
forall t. Binary t => t -> Put
put a
y
    get :: Get (Edit a)
get = do
        Word8
tp <- Get Word8
getWord8
        case Word8
tp of
          Word8
0 -> a -> Edit a
forall a. a -> Edit a
Add (a -> Edit a) -> Get a -> Get (Edit a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get a
forall t. Binary t => Get t
get
          Word8
1 -> a -> Edit a
forall a. a -> Edit a
Rem (a -> Edit a) -> Get a -> Get (Edit a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get a
forall t. Binary t => Get t
get
          Word8
2 -> a -> Edit a
forall a. a -> Edit a
Copy (a -> Edit a) -> Get a -> Get (Edit a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get a
forall t. Binary t => Get t
get
          Word8
3 -> a -> a -> Edit a
forall a. a -> a -> Edit a
Swap (a -> a -> Edit a) -> Get a -> Get (a -> Edit a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get a
forall t. Binary t => Get t
get Get (a -> Edit a) -> Get a -> Get (Edit a)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Get a
forall t. Binary t => Get t
get
          Word8
_ -> String -> Get (Edit a)
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String
"The numer " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Word8 -> String
forall a. Show a => a -> String
show Word8
tp String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" is not a valid Edit item.")


instance Eq1 Edit where
  liftEq :: (a -> b -> Bool) -> Edit a -> Edit b -> Bool
liftEq a -> b -> Bool
cmp = Edit a -> Edit b -> Bool
go
    where go :: Edit a -> Edit b -> Bool
go (Add a
l) (Add b
r) = a -> b -> Bool
cmp a
l b
r
          go (Rem a
l) (Rem b
r) = a -> b -> Bool
cmp a
l b
r
          go (Copy a
l) (Copy b
r) = a -> b -> Bool
cmp a
l b
r
          go (Swap a
la a
lb) (Swap b
ra b
rb) = a -> b -> Bool
cmp a
la b
ra Bool -> Bool -> Bool
&& a -> b -> Bool
cmp a
lb b
rb
          go Edit a
_ Edit b
_ = Bool
False

instance Hashable a => Hashable (Edit a)

instance Hashable1 Edit

instance Lift a => Lift (Edit a) where
  liftTyped :: Edit a -> Q (TExp (Edit a))
liftTyped = (Exp -> TExp (Edit a)) -> Q Exp -> Q (TExp (Edit a))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Exp -> TExp (Edit a)
forall a. Exp -> TExp a
TExp (Q Exp -> Q (TExp (Edit a)))
-> (Edit a -> Q Exp) -> Edit a -> Q (TExp (Edit a))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Edit a -> Q Exp
forall t. Lift t => t -> Q Exp
lift
  lift :: Edit a -> Q Exp
lift (Add a
a) = Name -> [a] -> Q Exp
forall a (f :: * -> *).
(Lift a, Foldable f) =>
Name -> f a -> Q Exp
applyExp' 'Add [a
a]
  lift (Rem a
a) = Name -> [a] -> Q Exp
forall a (f :: * -> *).
(Lift a, Foldable f) =>
Name -> f a -> Q Exp
applyExp' 'Rem [a
a]
  lift (Copy a
a) = Name -> [a] -> Q Exp
forall a (f :: * -> *).
(Lift a, Foldable f) =>
Name -> f a -> Q Exp
applyExp' 'Copy [a
a]
  lift (Swap a
a a
b) = Name -> [a] -> Q Exp
forall a (f :: * -> *).
(Lift a, Foldable f) =>
Name -> f a -> Q Exp
applyExp' 'Swap [a
a, a
b]

instance NFData a => NFData (Edit a)

instance NFData1 Edit

instance Ord1 Edit where
  liftCompare :: (a -> b -> Ordering) -> Edit a -> Edit b -> Ordering
liftCompare a -> b -> Ordering
cmp = Edit a -> Edit b -> Ordering
go
    where go :: Edit a -> Edit b -> Ordering
go (Add a
a) (Add b
b) = a -> b -> Ordering
cmp a
a b
b
          go (Add a
_) Edit b
_ = Ordering
LT
          go Edit a
_ (Add b
_) = Ordering
GT
          go (Rem a
a) (Rem b
b) = a -> b -> Ordering
cmp a
a b
b
          go (Rem a
_) Edit b
_ = Ordering
LT
          go Edit a
_ (Rem b
_) = Ordering
GT
          go (Copy a
a) (Copy b
b) = a -> b -> Ordering
cmp a
a b
b
          go (Copy a
_) Edit b
_ = Ordering
LT
          go Edit a
_ (Copy b
_) = Ordering
GT
          go (Swap a
la a
lb) (Swap b
ra b
rb) = a -> b -> Ordering
cmp a
la b
ra Ordering -> Ordering -> Ordering
forall a. Semigroup a => a -> a -> a
<> a -> b -> Ordering
cmp a
lb b
rb


-- | Determine the standard edit score for the /Levenshtein distance/.
editScore
  :: Edit a  -- ^ The given 'Edit' to convert to a score.
  -> Int  -- ^ The score of the given 'Edit' object.
editScore :: Edit a -> Int
editScore (Add a
_) = Int
1
editScore (Rem a
_) = Int
1
editScore (Copy a
_) = Int
0
editScore (Swap a
_ a
_) = Int
1

-- | Determine the score for the /Levenshtein distance/ for a 'Foldable' of 'Edit's.
editScore' :: Foldable f
  => f (Edit a)  -- ^ The given 'Foldable' of edits to determine the score from.
  -> Int  -- ^ The edit score given for the given 'Foldable' of 'Edit's.
editScore' :: f (Edit a) -> Int
editScore' = (Edit a -> Int -> Int) -> Int -> f (Edit a) -> Int
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (Int -> Int -> Int
forall a. Num a => a -> a -> a
(+) (Int -> Int -> Int) -> (Edit a -> Int) -> Edit a -> Int -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Edit a -> Int
forall a. Edit a -> Int
editScore) Int
0

-- | Obtain the /Levenshtein distance/ from one sequence ot another, given we each time add one point for an addition, deletion and substitution.
levenshtein :: Eq a
  => [a]  -- ^ The original given sequence.
  -> [a]  -- ^ The target given sequence.
  -> (Int, [Edit a])  -- ^ A 2-tuple with the edit score as first item, and a list of modifications as second item to transform the first sequence to the second one.
levenshtein :: [a] -> [a] -> (Int, [Edit a])
levenshtein = (a -> a -> Bool) -> [a] -> [a] -> (Int, [Edit a])
forall a. (a -> a -> Bool) -> [a] -> [a] -> (Int, [Edit a])
levenshtein' a -> a -> Bool
forall a. Eq a => a -> a -> Bool
(==)

-- | Obtain the /Levenshtein distance/ from one sequence ot another, given we each time add one point for an addition, deletion and substitution. The
-- equality relation is given, for example to perform case-insensitive matching.
levenshtein'
  :: (a -> a -> Bool)  -- ^ A function that determines whether the two items of the sequences are equivalent.
  -> [a]  -- ^ The original given sequence.
  -> [a]  -- ^ The target given sequence.
  -> (Int, [Edit a])  -- ^ A 2-tuple with the edit score as first item, and a list of modifications as second item to transform the first sequence to the second one.
levenshtein' :: (a -> a -> Bool) -> [a] -> [a] -> (Int, [Edit a])
levenshtein' a -> a -> Bool
eq [a]
xs' [a]
ys' = ([Edit a] -> [Edit a]) -> (Int, [Edit a]) -> (Int, [Edit a])
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (d, b) (d, c)
second [Edit a] -> [Edit a]
forall a. [a] -> [a]
reverse ((a -> a -> Bool) -> [a] -> [a] -> (Int, [Edit a])
forall a. (a -> a -> Bool) -> [a] -> [a] -> (Int, [Edit a])
reversedLevenshtein' a -> a -> Bool
eq [a]
xs' [a]
ys')

-- | Obtain the /Levenshtein distance/ where the list of edits is in /reverse/ order. This because this is more efficient and is thus useful if the order of
-- the 'Edit's does not matter much.
reversedLevenshtein :: Eq a
  => [a]  -- ^ The original given sequence.
  -> [a]  -- ^ The target given sequence.
  -> (Int, [Edit a])  -- ^ A 2-tuple with the edit score as first item, and a list of modifications in /reversed/ order as second item to transform the first sequence to the second one.
reversedLevenshtein :: [a] -> [a] -> (Int, [Edit a])
reversedLevenshtein = (a -> a -> Bool) -> [a] -> [a] -> (Int, [Edit a])
forall a. (a -> a -> Bool) -> [a] -> [a] -> (Int, [Edit a])
reversedLevenshtein' a -> a -> Bool
forall a. Eq a => a -> a -> Bool
(==)

-- | Obtain the /Levenshtein distance/ where the list of edits is in /reverse/ order. This because this is more efficient and is thus useful if the order of
-- the 'Edit's does not matter much. The equivalence relation is given through a parameter, and thus can for example allow case-insensitive matching.
reversedLevenshtein'
  :: (a -> a -> Bool)  -- ^ The given equivalence relation to work with.
  -> [a]  -- ^ The original given sequence.
  -> [a]  -- ^ The target sequence.
  -> (Int, [Edit a])  -- ^ A 2-tuple with the edit score as first item, and a list of modifications in /reversed/ order as second item to transform the first sequence to the second one.
reversedLevenshtein' :: (a -> a -> Bool) -> [a] -> [a] -> (Int, [Edit a])
reversedLevenshtein' a -> a -> Bool
eq = (a -> a -> Bool)
-> (a -> Int)
-> (a -> Int)
-> (a -> a -> Int)
-> [a]
-> [a]
-> (Int, [Edit a])
forall a.
(a -> a -> Bool)
-> (a -> Int)
-> (a -> Int)
-> (a -> a -> Int)
-> [a]
-> [a]
-> (Int, [Edit a])
genericReversedLevenshtein' a -> a -> Bool
eq a -> Int
forall b. b -> Int
c1 a -> Int
forall b. b -> Int
c1 ((a -> Int) -> a -> a -> Int
forall a b. a -> b -> a
const a -> Int
forall b. b -> Int
c1)
  where c1 :: b -> Int
c1 = Int -> b -> Int
forall a b. a -> b -> a
const Int
1

-- | A function to determine the /Levenshtein distance/ by specifying the cost functions of adding, removing and editing characters. The 2-tuple returns the distance
-- as first item of the 2-tuple, and the list of 'Edit's in reverse order as second item.
genericReversedLevenshtein :: Eq a
  => (a -> Int)  -- ^ The cost of adding the given item.
  -> (a -> Int)  -- ^ The cost of removing the given item.
  -> (a -> a -> Int)  -- ^ The cost that it takes to replace an item of the first parameter with one of the second parameter.
  -> [a]  -- ^ The original given sequence.
  -> [a]  -- ^ The target sequence.
  -> (Int, [Edit a])  -- ^ A 2-tuple with the edit score as first item, and a list of modifications in /reversed/ order as second item to transform the first sequence to the second one.
genericReversedLevenshtein :: (a -> Int)
-> (a -> Int) -> (a -> a -> Int) -> [a] -> [a] -> (Int, [Edit a])
genericReversedLevenshtein = (a -> a -> Bool)
-> (a -> Int)
-> (a -> Int)
-> (a -> a -> Int)
-> [a]
-> [a]
-> (Int, [Edit a])
forall a.
(a -> a -> Bool)
-> (a -> Int)
-> (a -> Int)
-> (a -> a -> Int)
-> [a]
-> [a]
-> (Int, [Edit a])
genericReversedLevenshtein' a -> a -> Bool
forall a. Eq a => a -> a -> Bool
(==)

-- | A function to determine the /Levenshtein distance/ by specifying the cost functions of adding, removing and editing characters. The 2-tuple returns the distance
-- as first item of the 2-tuple, and the list of 'Edit's in reverse order as second item.
genericReversedLevenshtein'
  :: (a -> a -> Bool)  -- ^ The given equivalence relation to work with.
  -> (a -> Int)  -- ^ The cost of adding the given item.
  -> (a -> Int)  -- ^ The cost of removing the given item.
  -> (a -> a -> Int)  -- ^ The cost that it takes to replace an item of the first parameter with one of the second parameter.
  -> [a]  -- ^ The original given sequence.
  -> [a]  -- ^ The target sequence.
  -> (Int, [Edit a])  -- ^ A 2-tuple with the edit score as first item, and a list of modifications in /reversed/ order as second item to transform the first sequence to the second one.
genericReversedLevenshtein' :: (a -> a -> Bool)
-> (a -> Int)
-> (a -> Int)
-> (a -> a -> Int)
-> [a]
-> [a]
-> (Int, [Edit a])
genericReversedLevenshtein' a -> a -> Bool
eq a -> Int
ad a -> Int
rm a -> a -> Int
sw [a]
xs' [a]
ys' = [(Int, [Edit a])] -> (Int, [Edit a])
forall a. [a] -> a
last (([(Int, [Edit a])] -> a -> [(Int, [Edit a])])
-> [(Int, [Edit a])] -> [a] -> [(Int, [Edit a])]
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl ([a] -> [(Int, [Edit a])] -> a -> [(Int, [Edit a])]
nextRow [a]
ys') [(Int, [Edit a])]
row0 [a]
xs')
  where
    row0 :: [(Int, [Edit a])]
row0 = ((Int, [Edit a]) -> a -> (Int, [Edit a]))
-> (Int, [Edit a]) -> [a] -> [(Int, [Edit a])]
forall b a. (b -> a -> b) -> b -> [a] -> [b]
scanl (\(Int
w, [Edit a]
is) a
i -> (Int
wInt -> Int -> Int
forall a. Num a => a -> a -> a
+a -> Int
ad a
i, a -> Edit a
forall a. a -> Edit a
Add a
iEdit a -> [Edit a] -> [Edit a]
forall a. a -> [a] -> [a]
: [Edit a]
is)) (Int
0, []) [a]
ys'
    nextCell :: a
-> (Int, [Edit a])
-> a
-> (Int, [Edit a])
-> (Int, [Edit a])
-> (Int, [Edit a])
nextCell a
x (Int
l, [Edit a]
le) a
y (Int
lt, [Edit a]
lte) (Int
t, [Edit a]
te)
      | a -> a -> Bool
eq a
x a
y = (Int
lt, a -> Edit a
forall a. a -> Edit a
Copy a
x Edit a -> [Edit a] -> [Edit a]
forall a. a -> [a] -> [a]
: [Edit a]
lte)
      | Int
scs Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
scr Bool -> Bool -> Bool
&& Int
scs Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
sca = (Int
scs, a -> a -> Edit a
forall a. a -> a -> Edit a
Swap a
x a
yEdit a -> [Edit a] -> [Edit a]
forall a. a -> [a] -> [a]
:[Edit a]
lte)
      | Int
sca Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
scr = (Int
sca, a -> Edit a
forall a. a -> Edit a
Add a
yEdit a -> [Edit a] -> [Edit a]
forall a. a -> [a] -> [a]
:[Edit a]
le)
      | Bool
otherwise = (Int
scr, a -> Edit a
forall a. a -> Edit a
Rem a
xEdit a -> [Edit a] -> [Edit a]
forall a. a -> [a] -> [a]
:[Edit a]
te)
      where sca :: Int
sca = Int
l Int -> Int -> Int
forall a. Num a => a -> a -> a
+ a -> Int
ad a
y
            scr :: Int
scr = Int
t Int -> Int -> Int
forall a. Num a => a -> a -> a
+ a -> Int
rm a
x
            scs :: Int
scs = Int
lt Int -> Int -> Int
forall a. Num a => a -> a -> a
+ a -> a -> Int
sw a
x a
y
    curryNextCell :: a
-> (Int, [Edit a])
-> ((a, (Int, [Edit a])), (Int, [Edit a]))
-> (Int, [Edit a])
curryNextCell a
x (Int, [Edit a])
l = ((a, (Int, [Edit a])) -> (Int, [Edit a]) -> (Int, [Edit a]))
-> ((a, (Int, [Edit a])), (Int, [Edit a])) -> (Int, [Edit a])
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry ((a -> (Int, [Edit a]) -> (Int, [Edit a]) -> (Int, [Edit a]))
-> (a, (Int, [Edit a])) -> (Int, [Edit a]) -> (Int, [Edit a])
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry (a
-> (Int, [Edit a])
-> a
-> (Int, [Edit a])
-> (Int, [Edit a])
-> (Int, [Edit a])
nextCell a
x (Int, [Edit a])
l))
    nextRow :: [a] -> [(Int, [Edit a])] -> a -> [(Int, [Edit a])]
nextRow [a]
ys da :: [(Int, [Edit a])]
da@(~((Int
dn, [Edit a]
de):[(Int, [Edit a])]
ds)) a
x = ((Int, [Edit a])
 -> ((a, (Int, [Edit a])), (Int, [Edit a])) -> (Int, [Edit a]))
-> (Int, [Edit a])
-> [((a, (Int, [Edit a])), (Int, [Edit a]))]
-> [(Int, [Edit a])]
forall b a. (b -> a -> b) -> b -> [a] -> [b]
scanl (a
-> (Int, [Edit a])
-> ((a, (Int, [Edit a])), (Int, [Edit a]))
-> (Int, [Edit a])
curryNextCell a
x) (Int
dnInt -> Int -> Int
forall a. Num a => a -> a -> a
+a -> Int
rm a
x,a -> Edit a
forall a. a -> Edit a
Rem a
xEdit a -> [Edit a] -> [Edit a]
forall a. a -> [a] -> [a]
:[Edit a]
de) ([(a, (Int, [Edit a]))]
-> [(Int, [Edit a])] -> [((a, (Int, [Edit a])), (Int, [Edit a]))]
forall a b. [a] -> [b] -> [(a, b)]
zip ([a] -> [(Int, [Edit a])] -> [(a, (Int, [Edit a]))]
forall a b. [a] -> [b] -> [(a, b)]
zip [a]
ys [(Int, [Edit a])]
da) [(Int, [Edit a])]
ds)