1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
|
{-# LANGUAGE OverloadedStrings #-}
{-# OPTIONS_GHC -fno-warn-missing-signatures #-}
module HeadersText (headers) where
import Common (pathTo, rechunkT)
import Control.Applicative
import Test.Tasty.Bench (Benchmark, bench, bgroup, nf)
import Data.Char (isSpace)
import qualified Data.Attoparsec.Text as T
import qualified Data.Attoparsec.Text.Lazy as TL
import qualified Data.Text.IO as T
header = do
name <- T.takeWhile1 (T.inClass "a-zA-Z0-9_-") <* T.char ':' <* T.skipSpace
body <- (:) <$> bodyLine <*> many (T.takeWhile1 isSpace *> bodyLine)
return (name, body)
bodyLine = T.takeTill (\c -> c == '\r' || c == '\n') <* T.endOfLine
requestLine =
(,,) <$>
(method <* T.skipSpace) <*>
(T.takeTill isSpace <* T.skipSpace) <*>
httpVersion
where method = "GET" <|> "POST"
httpVersion = "HTTP/" *> ((,) <$> (int <* T.char '.') <*> int)
responseLine = (,,) <$>
(httpVersion <* T.skipSpace) <*>
(int <* T.skipSpace) <*>
bodyLine
int :: T.Parser Int
int = T.decimal
request = (,) <$> (requestLine <* T.endOfLine) <*> many header
response = (,) <$> responseLine <*> many header
headers :: IO Benchmark
headers = do
req <- T.readFile =<< pathTo "http-request.txt"
resp <- T.readFile =<< pathTo "http-response.txt"
let reql = rechunkT 4 req
respl = rechunkT 4 resp
return $ bgroup "headers" [
bgroup "T" [
bench "request" $ nf (T.parseOnly request) req
, bench "response" $ nf (T.parseOnly response) resp
]
, bgroup "TL" [
bench "request" $ nf (TL.parse request) reql
, bench "response" $ nf (TL.parse response) respl
]
]
|
