benchmarks for streamUtf8

bench.txt

benchmarking lazy text
mean: 3.904823 ms, lb 3.844596 ms, ub 4.018289 ms, ci 0.950
std dev: 410.2641 us, lb 239.7706 us, ub 612.5513 us, ci 0.950


benchmarking new conduit
mean: 7.473182 ms, lb 7.354699 ms, ub 7.651235 ms, ci 0.950
std dev: 739.4707 us, lb 538.1933 us, ub 975.3947 us, ci 0.950


benchmarking stream
mean: 7.265383 ms, lb 7.146255 ms, ub 7.471312 ms, ci 0.950
std dev: 784.0801 us, lb 537.1422 us, ub 1.190850 ms, ci 0.950


benchmarking pipes
mean: 4.295031 ms, lb 4.204026 ms, ub 4.424228 ms, ci 0.950
std dev: 548.2546 us, lb 418.0959 us, ub 696.1383 us, ci 0.950

utf8-bench.hs

{-# LANGUAGE RankNTypes, BangPatterns #-}
import Data.Conduit
import qualified Data.Conduit.Text as CT
import Criterion.Main
import qualified Data.Text as T
import qualified Data.Text.Lazy as TL
import qualified Data.Text.Lazy.Encoding as TLE
import qualified Data.ByteString as S
import qualified Data.ByteString.Lazy as L
import qualified Data.Conduit.List as CL
import Data.Text.StreamDecoding
import Data.Text.Encoding (decodeUtf8)
import qualified Pipes.Text as PT
import qualified Pipes as P
import Lens.Family (view)
import Control.Monad (void)
import Data.Functor.Identity 
lengthT :: Monad m => Consumer T.Text m Int
lengthT = CL.fold (\x y -> x + T.length y) 0

main :: IO ()
main = do
    bs <- S.readFile "utf8-bench.hs"
    let !bss = replicate 1000 bs
        !src = mapM_ yield bss
        !producer = P.each bss 
        !lbs = L.fromChunks bss
    defaultMain
        [ -- bench "old conduit" $ whnf (\src' -> runException_ $ src' $$ OT.decode OT.utf8 =$ lengthT) src
          bench "lazy text" $ whnf (TL.length . TLE.decodeUtf8) lbs
        , bench "new conduit" $ whnf (\src' -> runException_ $ src' $$ CT.decode CT.utf8 =$ lengthT) src
        , bench "stream" $ whnf calcLen bss
        , bench "pipes" $ whnf (runIdentity . PT.length . void . view PT.decodeUtf8) producer
        ]

calcLen [] = 0
calcLen (bs0:bss0) =
    loop (streamUtf8 bs0) bss0 0
  where
    loop (DecodeResultSuccess t next) bss total =
        let total' = total + T.length t
         in case bss of
                [] -> total'
                bs:bss' -> total' `seq` loop (next bs) bss' total'