{-# 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 :: forall a. Costs a -> a -> Int
cost (ConstantCost Int
i) a
_ = Int
i
cost (VariableCost a -> Int
f) 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 EditCosts
ec 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 EditCosts
ec 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 EditCosts
ec Char
old 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 EditCosts
ec Char
backwards 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 {
    deletionCosts :: Costs Char
deletionCosts = Int -> Costs Char
forall a. Int -> Costs a
ConstantCost Int
1,
    insertionCosts :: Costs Char
insertionCosts = Int -> Costs Char
forall a. Int -> Costs a
ConstantCost Int
1,
    substitutionCosts :: Costs (Char, Char)
substitutionCosts = Int -> Costs (Char, Char)
forall a. Int -> Costs a
ConstantCost Int
1,
    transpositionCosts :: Costs (Char, Char)
transpositionCosts = Int -> Costs (Char, Char)
forall a. Int -> Costs a
ConstantCost Int
1
}

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