Add high order function for checking equality after transformation

Data/Text.hs

@@ -167,6 +167,7 @@ module Data.Text
     , isPrefixOf
     , isSuffixOf
     , isInfixOf
+    , transformEq
 
     -- ** View patterns
     , stripPrefix
@@ -1753,6 +1754,15 @@ isInfixOf needle haystack
     isInfixOf (singleton n) h = S.elem n (S.stream h)
   #-}
 
+-- | The 'transformEq' function takes a `Text -> Text` function
+-- and two 'Text's if the 'Text's are equal after transformation. This
+-- function relies on fusion to avoid materialising the transformed 'Text'
+transformEq :: (Text -> Text) -> Text -> Text -> Bool
+transformEq f x y
+    | length x == length y = S.stream (f x) == S.stream (f y)
+    | otherwise            = False
+{-# INLINE [1] transformEq #-}
+
 -------------------------------------------------------------------------------
 -- * View patterns
 

benchmarks/haskell/Benchmarks.hs

@@ -14,6 +14,7 @@ import qualified Benchmarks.Concat as Concat
 import qualified Benchmarks.DecodeUtf8 as DecodeUtf8
 import qualified Benchmarks.EncodeUtf8 as EncodeUtf8
 import qualified Benchmarks.Equality as Equality
+import qualified Benchmarks.TransformEq as TransformEq
 import qualified Benchmarks.FileRead as FileRead
 import qualified Benchmarks.FoldLines as FoldLines
 import qualified Benchmarks.Mul as Mul
@@ -63,6 +64,7 @@ benchmarks = do
         , Search.benchmark (tf "russian.txt") "принимая"
         , Stream.benchmark (tf "russian.txt")
         , WordFrequencies.benchmark (tf "russian.txt")
+        , TransformEq.benchmark
         ]
 
     -- Program-like benchmarks

benchmarks/haskell/Benchmarks/TransformEq.hs

@@ -0,0 +1,30 @@
+-- | Compare a string after a transformation
+--
+-- Tested in this benchmark:
+--
+-- * Comparison of transformed strings via transformEq
+--
+module Benchmarks.TransformEq
+    ( benchmark
+    ) where
+
+import Criterion (Benchmark, bgroup, bench, whnf)
+import Data.Function (on)
+import Data.Text (transformEq, toCaseFold, pack)
+
+benchmark :: IO Benchmark
+benchmark = do
+    let
+      equiv = (pack "Fooooooo", pack "fOOOOOOO")
+      notEq = (pack "fooooooo", pack "barrrrrr")
+      lengthNotEq = (pack "foo", pack "foooooooo")
+      eq = uncurry ((==) `on` toCaseFold)
+      transEq = uncurry $ transformEq toCaseFold
+    return $ bgroup "transformEq"
+        [ bench "Text ==: Eq" $ whnf eq equiv
+        , bench "Text transformEq: Eq" $ whnf transEq equiv
+        , bench "Text ==: Not Eq" $ whnf eq notEq
+        , bench "Text transformEq: Not Eq" $ whnf transEq notEq
+        , bench "Text ==: Not Length" $ whnf eq lengthNotEq
+        , bench "Text transformEq: Not Length" $ whnf transEq lengthNotEq
+        ]

benchmarks/text-benchmarks.cabal

@@ -76,6 +76,7 @@ executable text-benchmarks
     Benchmarks.Replace
     Benchmarks.Search
     Benchmarks.Stream
+    Benchmarks.TransformEq
     Benchmarks.WordFrequencies
 
   -- Source code for IUT (implementation under test)