parser_benchmarks/http/attoparsec/src/Main.hs at 15dfddbe37e06a1d9d72ac9e47dcedeee8f82505 · rust-bakery/parser_benchmarks · GitHub

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
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
{-# LANGUAGE OverloadedStrings #-}

import           Criterion.Main                   (bench, defaultMain, env, whnf)
import qualified Data.ByteString                  as B

import           Control.Applicative
import           Data.Attoparsec.ByteString       as P
import           Data.Attoparsec.ByteString.Char8 (char8, endOfLine, isDigit_w8, isEndOfLine, isHorizontalSpace)
import           Data.ByteString                  (ByteString)
import           Data.Word                        (Word8)

isToken :: Word8 -> Bool
isToken w =
  w <= 127
    && w > 31 -- "\0-\31"
    && ( w /= 40 -- "("
           && w /= 41 -- ")"
           && w /= 60 -- "<"
           && w /= 62 -- ">"
           && w /= 64 -- "@"
           && w /= 44 -- ","
           && w /= 59 -- ";"
           && w /= 58 -- ":"
           && w /= 92 -- "\\"
           && w /= 34 -- "\""
           && w /= 91 -- "["
           && w /= 93 -- "]"
           && w /= 63 -- "?"
           && w /= 61 -- "="
           && w /= 123 -- "{"
           && w /= 125 -- "}"
           && w /= 32 -- " "
           && w /= 9 -- "\t")
       )

skipSpaces :: Parser ()
skipSpaces = satisfy isHorizontalSpace *> skipWhile isHorizontalSpace

data Request = Request {
      requestMethod  :: !ByteString
    , requestUri     :: !ByteString
    , requestVersion :: !ByteString
    } deriving (Eq, Ord, Show)

httpVersion :: Parser ByteString
httpVersion = "HTTP/" *> P.takeWhile (\c -> isDigit_w8 c || c == 46)

requestLine :: Parser Request
requestLine = Request <$> (takeWhile1 isToken <* char8 ' ')
                      <*> (takeWhile1 (/=32) <* char8 ' ')
                      <*> (httpVersion <* endOfLine)

data Header = Header {
      headerName  :: !ByteString
    , headerValue :: ![ByteString]
    } deriving (Eq, Ord, Show)

messageHeader :: Parser Header
messageHeader = Header
  <$> (P.takeWhile isToken <* char8 ':' <* skipWhile isHorizontalSpace)
  <*> ((:) <$> (takeTill isEndOfLine <* endOfLine)
           <*> many ( skipSpaces *> takeTill isEndOfLine <* endOfLine))

request :: Parser (Request, [Header])
request = (,) <$> requestLine <*> many messageHeader <* endOfLine

allRequests :: Parser [(Request, [Header])]
allRequests = many1 request

smallFile :: FilePath
smallFile = "../http-requests.txt"

biggerFile :: FilePath
biggerFile = "../bigger.txt"

main :: IO ()
main = defaultMain
    [ env (B.readFile smallFile) $ \small ->
        bench "small" $ whnf (P.parseOnly allRequests) small,
      env (B.readFile biggerFile) $ \big ->
        bench "big" $ whnf (P.parseOnly allRequests) big
    ]