{-# OPTIONS_GHC -funbox-strict-fields #-}

module Text.EditDistance.EditCosts (
    Costs(..),
    EditCosts(..), deletionCost, insertionCost, substitutionCost, transpositionCost,
    defaultEditCosts, isDefaultEditCosts
  ) where

data Costs a = ConstantCost !Int
             | VariableCost (a -> Int)

{-# INLINE cost #-}
cost :: Costs a -> a -> Int
cost :: Costs a -> a -> Int
cost (ConstantCost i :: Int
i) _ = Int
i
cost (VariableCost f :: a -> Int
f) x :: a
x = a -> Int
f a
x

data EditCosts = EditCosts {
    EditCosts -> Costs Char
deletionCosts :: Costs Char,             -- ^ Cost of deleting the specified character from the left string
    EditCosts -> Costs Char
insertionCosts :: Costs Char,            -- ^ Cost of inserting the specified characters into the right string
    EditCosts -> Costs (Char, Char)
substitutionCosts :: Costs (Char, Char), -- ^ Cost of substituting a character from the left string with one from the right string -- with arguments in that order.
    EditCosts -> Costs (Char, Char)
transpositionCosts :: Costs (Char, Char) -- ^ Cost of moving one character backwards and the other forwards -- with arguments in that order.
  }

{-# INLINE deletionCost #-}
deletionCost :: EditCosts -> Char -> Int
deletionCost :: EditCosts -> Char -> Int
deletionCost ec :: EditCosts
ec deleted :: Char
deleted = Costs Char -> Char -> Int
forall a. Costs a -> a -> Int
cost (EditCosts -> Costs Char
deletionCosts EditCosts
ec) Char
deleted

{-# INLINE insertionCost #-}
insertionCost :: EditCosts -> Char -> Int
insertionCost :: EditCosts -> Char -> Int
insertionCost ec :: EditCosts
ec inserted :: Char
inserted = Costs Char -> Char -> Int
forall a. Costs a -> a -> Int
cost (EditCosts -> Costs Char
insertionCosts EditCosts
ec) Char
inserted

{-# INLINE substitutionCost #-}
substitutionCost :: EditCosts -> Char -> Char -> Int
substitutionCost :: EditCosts -> Char -> Char -> Int
substitutionCost ec :: EditCosts
ec old :: Char
old new :: Char
new = Costs (Char, Char) -> (Char, Char) -> Int
forall a. Costs a -> a -> Int
cost (EditCosts -> Costs (Char, Char)
substitutionCosts EditCosts
ec) (Char
old, Char
new)

{-# INLINE transpositionCost #-}
transpositionCost :: EditCosts -> Char -> Char -> Int
transpositionCost :: EditCosts -> Char -> Char -> Int
transpositionCost ec :: EditCosts
ec backwards :: Char
backwards forwards :: Char
forwards = Costs (Char, Char) -> (Char, Char) -> Int
forall a. Costs a -> a -> Int
cost (EditCosts -> Costs (Char, Char)
transpositionCosts EditCosts
ec) (Char
backwards, Char
forwards)

defaultEditCosts :: EditCosts
defaultEditCosts :: EditCosts
defaultEditCosts = EditCosts :: Costs Char
-> Costs Char
-> Costs (Char, Char)
-> Costs (Char, Char)
-> EditCosts
EditCosts {
    deletionCosts :: Costs Char
deletionCosts = Int -> Costs Char
forall a. Int -> Costs a
ConstantCost 1,
    insertionCosts :: Costs Char
insertionCosts = Int -> Costs Char
forall a. Int -> Costs a
ConstantCost 1,
    substitutionCosts :: Costs (Char, Char)
substitutionCosts = Int -> Costs (Char, Char)
forall a. Int -> Costs a
ConstantCost 1,
    transpositionCosts :: Costs (Char, Char)
transpositionCosts = Int -> Costs (Char, Char)
forall a. Int -> Costs a
ConstantCost 1
}

isDefaultEditCosts :: EditCosts -> Bool
isDefaultEditCosts :: EditCosts -> Bool
isDefaultEditCosts (EditCosts { deletionCosts :: EditCosts -> Costs Char
deletionCosts = ConstantCost 1, insertionCosts :: EditCosts -> Costs Char
insertionCosts = ConstantCost 1, substitutionCosts :: EditCosts -> Costs (Char, Char)
substitutionCosts = ConstantCost 1, transpositionCosts :: EditCosts -> Costs (Char, Char)
transpositionCosts = ConstantCost 1 }) = Bool
True
isDefaultEditCosts _ = Bool
False