1{-# LANGUAGE OverloadedStrings #-} 2{-# OPTIONS_GHC -fno-warn-missing-signatures #-} 3module HeadersText (headers) where 4 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 13 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) 18 19bodyLine = T.takeTill (\c -> c == '\r' || c == '\n') <* T.endOfLine 20 21requestLine = 22 (,,) <$> 23 (method <* T.skipSpace) <*> 24 (T.takeTill isSpace <* T.skipSpace) <*> 25 httpVersion 26 where method = "GET" <|> "POST" 27 28httpVersion = "HTTP/" *> ((,) <$> (int <* T.char '.') <*> int) 29 30responseLine = (,,) <$> 31 (httpVersion <* T.skipSpace) <*> 32 (int <* T.skipSpace) <*> 33 bodyLine 34 35int :: T.Parser Int 36int = T.decimal 37 38request = (,) <$> (requestLine <* T.endOfLine) <*> many header 39 40response = (,) <$> responseLine <*> many header 41 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 ] 58