Skip to content
Snippets Groups Projects
Commit 60ab2baf authored by Jasper Van der Jeugt's avatar Jasper Van der Jeugt
Browse files

Purify Replace benchmark

parent cc24e80b
No related branches found
No related tags found
No related merge requests found
......@@ -48,7 +48,7 @@ benchmarks = do
, Ordering.benchmark (tf "russian.txt")
, Pure.benchmark (tf "japanese.txt")
, ReadNumbers.benchmark (tf "numbers.txt")
, Replace.benchmark (tf "russian.txt") sink "принимая" "своем"
, Replace.benchmark (tf "russian.txt") "принимая" "своем"
, Search.benchmark (tf "russian.txt") "принимая"
, WordCount.benchmark (tf "russian.txt")
]
......
-- | Replace a string by another string in a file
-- | Replace a string by another string
--
module Data.Text.Benchmarks.Replace
( benchmark
) where
import Criterion (Benchmark, bgroup, bench)
import System.IO (Handle)
import Criterion (Benchmark, bgroup, bench, nf)
import qualified Data.ByteString.Char8 as B
import qualified Data.ByteString.Lazy as BL
import qualified Data.ByteString.Lazy.Search as BL
......@@ -13,19 +12,14 @@ import qualified Data.Text.Lazy as TL
import qualified Data.Text.Lazy.Encoding as TL
import qualified Data.Text.Lazy.IO as TL
benchmark :: FilePath -> Handle -> String -> String -> IO Benchmark
benchmark fp sink pat sub = return $ bgroup "Replace"
-- We have benchmarks for lazy text and lazy bytestrings. We also benchmark
-- without the acual replacement, so we can get an idea of what time is
-- spent on IO and computations.
[ bench "LazyText" $ TL.readFile fp >>=
TL.hPutStr sink . TL.replace tpat tsub
, bench "LazyTextNull" $ TL.readFile fp >>= TL.hPutStr sink
, bench "LazyByteString" $ BL.readFile fp >>=
BL.hPutStr sink . BL.replace bpat bsub
, bench "LazyByteStringNull" $ BL.readFile fp >>= BL.hPutStr sink
]
benchmark :: FilePath -> String -> String -> IO Benchmark
benchmark fp pat sub = do
tl <- TL.readFile fp
bl <- BL.readFile fp
return $ bgroup "Replace"
[ bench "LazyText" $ nf (TL.length . TL.replace tpat tsub) tl
, bench "LazyByteString" $ nf (BL.length . BL.replace bpat bsub) bl
]
where
tpat = TL.pack pat
tsub = TL.pack sub
......
0% Loading or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment