{-# LANGUAGE RecordWildCards #-}

-- | This module supports a general definition of costs for performing edit operations
--   on 2 lists of elements
module Data.Text.Costs where

import Protolude

-- | Current operation in a cost matrix and current cost
data Cost
  = Insertion Int
  | Deletion Int
  | Substitution Int
  | NoAction Int
  deriving (Cost -> Cost -> Bool
(Cost -> Cost -> Bool) -> (Cost -> Cost -> Bool) -> Eq Cost
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Cost -> Cost -> Bool
$c/= :: Cost -> Cost -> Bool
== :: Cost -> Cost -> Bool
$c== :: Cost -> Cost -> Bool
Eq, Int -> Cost -> ShowS
[Cost] -> ShowS
Cost -> String
(Int -> Cost -> ShowS)
-> (Cost -> String) -> ([Cost] -> ShowS) -> Show Cost
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Cost] -> ShowS
$cshowList :: [Cost] -> ShowS
show :: Cost -> String
$cshow :: Cost -> String
showsPrec :: Int -> Cost -> ShowS
$cshowsPrec :: Int -> Cost -> ShowS
Show)

-- | Return the cost of an operation
cost :: Cost -> Int
cost :: Cost -> Int
cost (Insertion Int
c) = Int
c
cost (Deletion Int
c) = Int
c
cost (Substitution Int
c) = Int
c
cost (NoAction Int
c) = Int
c

-- | Nicer display for a cost
showCost :: Cost -> Text
showCost :: Cost -> Text
showCost (Insertion Int
c) = Text
"+ " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int -> Text
forall a b. (Show a, StringConv String b) => a -> b
show Int
c
showCost (Deletion Int
c) = Text
"- " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int -> Text
forall a b. (Show a, StringConv String b) => a -> b
show Int
c
showCost (Substitution Int
c) = Text
"~ " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int -> Text
forall a b. (Show a, StringConv String b) => a -> b
show Int
c
showCost (NoAction Int
c) = Text
"o " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int -> Text
forall a b. (Show a, StringConv String b) => a -> b
show Int
c

-- | This component contains functions to evaluate the cost of
--   substituting, inserting, deleting an element
data Costs a = Costs
  { forall a. Costs a -> a -> a -> Int
substitutionCost :: a -> a -> Int,
    forall a. Costs a -> a -> Int
insertionCost :: a -> Int,
    forall a. Costs a -> a -> Int
deletionCost :: a -> Int,
    forall a. Costs a -> a -> a -> Int -> Int -> Int -> Cost
lowerCost :: a -> a -> Int -> Int -> Int -> Cost
  }

-- | Classic costs for the Levenshtein distance
--   applied to characters in a piece of Text
textLevenshteinCosts :: Costs Char
textLevenshteinCosts :: Costs Char
textLevenshteinCosts = forall a. Eq a => Costs a
levenshteinCosts @Char

-- | Classic costs for the Levenshtein distance
levenshteinCosts :: forall a. (Eq a) => Costs a
levenshteinCosts :: forall a. Eq a => Costs a
levenshteinCosts = Costs {a -> Int
a -> a -> Int
a -> a -> Int -> Int -> Int -> Cost
lowerCost :: a -> a -> Int -> Int -> Int -> Cost
deletionCost :: a -> Int
insertionCost :: a -> Int
substitutionCost :: a -> a -> Int
lowerCost :: a -> a -> Int -> Int -> Int -> Cost
deletionCost :: a -> Int
insertionCost :: a -> Int
substitutionCost :: a -> a -> Int
..}
  where
    substitutionCost :: a -> a -> Int
    substitutionCost :: a -> a -> Int
substitutionCost a
a1 a
a2 = if a
a1 a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
a2 then Int
0 else Int
1

    insertionCost :: a -> Int
    insertionCost :: a -> Int
insertionCost = Int -> a -> Int
forall a b. a -> b -> a
const Int
1

    deletionCost :: a -> Int
    deletionCost :: a -> Int
deletionCost = Int -> a -> Int
forall a b. a -> b -> a
const Int
1

    lowerCost :: a -> a -> Int -> Int -> Int -> Cost
    lowerCost :: a -> a -> Int -> Int -> Int -> Cost
lowerCost a
a1 a
a2 Int
del Int
subst Int
ins = do
      let (Cost
opDel, Cost
opSubst, Cost
opIns) = (Int -> Cost
Deletion Int
del, Int -> Cost
Substitution Int
subst, Int -> Cost
Insertion Int
ins)
      if Int
ins Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
del
        then (if (Int
ins Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
subst) Bool -> Bool -> Bool
|| (Int
ins Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
subst Bool -> Bool -> Bool
&& a
a1 a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
a2) then Cost
opIns else Cost
opSubst)
        else (if (Int
del Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
subst) Bool -> Bool -> Bool
|| (Int
del Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
subst Bool -> Bool -> Bool
&& a
a1 a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
a2) then Cost
opDel else Cost
opSubst)