git.iko.soy/typeable/attoparsec
on 0.13.0.1 help sign in
typeable/attoparsec/benchmarks/HeadersText.hs
57 lines 1.7 kB history raw
1{-# LANGUAGE OverloadedStrings #-}
2{-# OPTIONS_GHC -fno-warn-missing-signatures #-}
3module HeadersText (headers) where
5import Common (pathTo, rechunkT)
6import Control.Applicative
7import Criterion.Main (bench, bgroup, nf)
8import Criterion.Types (Benchmark)
9import Data.Char (isSpace)
10import qualified Data.Attoparsec.Text as T
11import qualified Data.Attoparsec.Text.Lazy as TL
12import qualified Data.Text.IO as T
14header = do
15 name <- T.takeWhile1 (T.inClass "a-zA-Z0-9_-") <* T.char ':' <* T.skipSpace
16 body <- (:) <$> bodyLine <*> many (T.takeWhile1 isSpace *> bodyLine)
17 return (name, body)
19bodyLine = T.takeTill (\c -> c == '\r' || c == '\n') <* T.endOfLine
21requestLine =
22 (,,) <$>
23 (method <* T.skipSpace) <*>
24 (T.takeTill isSpace <* T.skipSpace) <*>
25 httpVersion
26 where method = "GET" <|> "POST"
28httpVersion = "HTTP/" *> ((,) <$> (int <* T.char '.') <*> int)
30responseLine = (,,) <$>
31 (httpVersion <* T.skipSpace) <*>
32 (int <* T.skipSpace) <*>
33 bodyLine
35int :: T.Parser Int
36int = T.decimal
38request = (,) <$> (requestLine <* T.endOfLine) <*> many header
40response = (,) <$> responseLine <*> many header
42headers :: IO Benchmark
43headers = do
44 req <- T.readFile =<< pathTo "http-request.txt"
45 resp <- T.readFile =<< pathTo "http-response.txt"
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 ]
57 ]