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

Add Streaming benchmarks

parent 3845ffd4
No related branches found
No related tags found
No related merge requests found
...@@ -19,6 +19,7 @@ import qualified Data.Text.Benchmarks.Pure as Pure ...@@ -19,6 +19,7 @@ import qualified Data.Text.Benchmarks.Pure as Pure
import qualified Data.Text.Benchmarks.ReadNumbers as ReadNumbers import qualified Data.Text.Benchmarks.ReadNumbers as ReadNumbers
import qualified Data.Text.Benchmarks.Replace as Replace import qualified Data.Text.Benchmarks.Replace as Replace
import qualified Data.Text.Benchmarks.Search as Search import qualified Data.Text.Benchmarks.Search as Search
import qualified Data.Text.Benchmarks.Stream as Stream
import qualified Data.Text.Benchmarks.WordFrequencies as WordFrequencies import qualified Data.Text.Benchmarks.WordFrequencies as WordFrequencies
import qualified Data.Text.Benchmarks.Programs.BigTable as Programs.BigTable import qualified Data.Text.Benchmarks.Programs.BigTable as Programs.BigTable
...@@ -52,6 +53,7 @@ benchmarks = do ...@@ -52,6 +53,7 @@ benchmarks = do
, ReadNumbers.benchmark (tf "numbers.txt") , ReadNumbers.benchmark (tf "numbers.txt")
, Replace.benchmark (tf "russian.txt") "принимая" "своем" , Replace.benchmark (tf "russian.txt") "принимая" "своем"
, Search.benchmark (tf "russian.txt") "принимая" , Search.benchmark (tf "russian.txt") "принимая"
, Stream.benchmark (tf "russian.txt")
, WordFrequencies.benchmark (tf "russian.txt") , WordFrequencies.benchmark (tf "russian.txt")
] ]
......
-- | This module contains a number of benchmarks for the different streaming
-- functions
--
-- Tested in this benchmark:
--
-- * Most streaming functions
--
{-# LANGUAGE BangPatterns #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}
module Data.Text.Benchmarks.Stream
( benchmark
) where
import Control.DeepSeq (NFData (..))
import Criterion (Benchmark, bgroup, bench, nf)
import Data.Text.Fusion.Internal (Step (..), Stream (..))
import qualified Data.ByteString as B
import qualified Data.ByteString.Lazy as BL
import qualified Data.Text.Encoding.Error as E
import qualified Data.Text.Encoding.Fusion as T
import qualified Data.Text.Lazy.Encoding.Fusion as TL
instance NFData a => NFData (Stream a) where
-- Currently, this implementation does not force evaluation of the size hint
rnf (Stream next s0 _) = go s0
where
go !s = case next s of
Done -> ()
Skip s' -> go s'
Yield x s' -> rnf x `seq` go s'
benchmark :: FilePath -> IO Benchmark
benchmark fp = do
-- Load data
bs <- B.readFile fp
lbs <- BL.readFile fp
return $ bgroup "Stream"
[ bgroup "streamUtf8"
[ bench "Text" $ nf (T.streamUtf8 E.lenientDecode) bs
, bench "LazyText" $ nf (TL.streamUtf8 E.lenientDecode) lbs
]
]
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