git.iko.soy/typeable/attoparsec
on master help sign in
Add lazy header parsing benchmarks
commite5a681b7d3946c4b08b727cc98b1b88a350d3617 authorBryan O'Sullivan <bryano@fb.com> dateTue 20 May 2014, 23:01 (12 years ago) parent66ee865
4 files changed+64−16
benchmarks/Benchmarks.hs+1−10 benchmarks/Common.hs+37 benchmarks/HeadersByteString.hs+13−3 benchmarks/HeadersText.hs+13−3
benchmarks/Benchmarks.hs+1−10
@@ -1,8 +1,8 @@
11{-# LANGUAGE BangPatterns, CPP #-}
22{-# OPTIONS_GHC -fno-warn-orphans #-}
33
4+import Common ()
45import Control.Applicative (many)
5−import Control.DeepSeq (NFData(rnf))
66import Criterion.Main (bench, bgroup, defaultMain, nf)
77import Data.Bits
88import Data.Char (isAlpha)
@@ -27,15 +27,6 @@ import qualified HeadersText
2727import qualified Links
2828import qualified Text.Parsec as P
2929
30−#if !MIN_VERSION_bytestring(0,10,0)
31−import Data.ByteString.Internal (ByteString(..))
32−instance NFData ByteString where
33− rnf (PS _ _ _) = ()
34−#endif
35−
36−instance NFData P.ParseError where
37− rnf = rnf . show
38−
3930chunksOf :: Int -> [a] -> [[a]]
4031chunksOf k = go
4132 where go xs = case splitAt k xs of
benchmarks/Common.hsnew file+37
@@ -0,0 +1,37 @@
1+{-# LANGUAGE CPP #-}
2+{-# OPTIONS_GHC -fno-warn-orphans #-}
3+
4+module Common (
5+ chunksOf
6+ , rechunkBS
7+ , rechunkT
8+ ) where
9+
10+import Control.DeepSeq (NFData(rnf))
11+import Text.Parsec (ParseError)
12+import qualified Data.ByteString as B
13+import qualified Data.ByteString.Lazy as BL
14+import qualified Data.Text as T
15+import qualified Data.Text.Lazy as TL
16+
17+#if !MIN_VERSION_bytestring(0,10,0)
18+import Data.ByteString.Internal (ByteString(..))
19+
20+instance NFData ByteString where
21+ rnf (PS _ _ _) = ()
22+#endif
23+
24+instance NFData ParseError where
25+ rnf = rnf . show
26+
27+chunksOf :: Int -> [a] -> [[a]]
28+chunksOf k = go
29+ where go xs = case splitAt k xs of
30+ ([],_) -> []
31+ (y, ys) -> y : go ys
32+
33+rechunkBS :: Int -> B.ByteString -> BL.ByteString
34+rechunkBS n = BL.fromChunks . map B.pack . chunksOf n . B.unpack
35+
36+rechunkT :: Int -> T.Text -> TL.Text
37+rechunkT n = TL.fromChunks . map T.pack . chunksOf n . T.unpack
benchmarks/HeadersByteString.hs+13−3
@@ -2,10 +2,12 @@
22{-# OPTIONS_GHC -fno-warn-missing-signatures #-}
33module HeadersByteString (headers) where
44
5+import Common (rechunkBS)
56import Control.Applicative
67import Criterion.Main (bench, bgroup, nf)
78import Criterion.Types (Benchmark)
89import qualified Data.Attoparsec.ByteString.Char8 as B
10+import qualified Data.Attoparsec.ByteString.Lazy as BL
911import qualified Data.ByteString.Char8 as B
1012
1113header = do
@@ -40,7 +42,15 @@ headers :: IO Benchmark
4042headers = do
4143 req <- B.readFile "http-request.txt"
4244 resp <- B.readFile "http-response.txt"
43− return $ bgroup "headersBS" [
44− bench "request" $ nf (B.parseOnly request) req
45− , bench "response" $ nf (B.parseOnly response) resp
45+ let reql = rechunkBS 4 req
46+ respl = rechunkBS 4 resp
47+ return $ bgroup "headers" [
48+ bgroup "B" [
49+ bench "request" $ nf (B.parseOnly request) req
50+ , bench "response" $ nf (B.parseOnly response) resp
51+ ]
52+ , bgroup "BL" [
53+ bench "request" $ nf (BL.parse request) reql
54+ , bench "response" $ nf (BL.parse response) respl
55+ ]
4656 ]
benchmarks/HeadersText.hs+13−3
@@ -2,11 +2,13 @@
22{-# OPTIONS_GHC -fno-warn-missing-signatures #-}
33module HeadersText (headers) where
44
5+import Common (rechunkT)
56import Control.Applicative
67import Criterion.Main (bench, bgroup, nf)
78import Criterion.Types (Benchmark)
89import Data.Char (isSpace)
910import qualified Data.Attoparsec.Text as T
11+import qualified Data.Attoparsec.Text.Lazy as TL
1012import qualified Data.Text.IO as T
1113
1214header = do
@@ -41,7 +43,15 @@ headers :: IO Benchmark
4143headers = do
4244 req <- T.readFile "http-request.txt"
4345 resp <- T.readFile "http-response.txt"
44− return $ bgroup "headersT" [
45− bench "request" $ nf (T.parseOnly request) req
46− , bench "response" $ nf (T.parseOnly response) resp
46+ let reql = rechunkT 4 req
47+ respl = rechunkT 4 resp
48+ return $ bgroup "headers" [
49+ bgroup "T" [
50+ bench "request" $ nf (T.parseOnly request) req
51+ , bench "response" $ nf (T.parseOnly response) resp
52+ ]
53+ , bgroup "TL" [
54+ bench "request" $ nf (TL.parse request) reql
55+ , bench "response" $ nf (TL.parse response) respl
56+ ]
4757 ]