git.iko.soy/typeable/wai
on master help sign in
adding benchmark.
cccf4eeKazu Yamamoto
warp/bench/Parser.hsnew file+95
compare with master
unifiedsplit
@@ -0,0 +1,95 @@
1+{-# LANGUAGE OverloadedStrings #-}
2+{-# LANGUAGE BangPatterns #-}
3+
4+module Main where
5+
6+import Control.Exception (throwIO)
7+import Control.Monad
8+import qualified Data.ByteString as S
9+import Data.ByteString.Char8 (ByteString)
10+import qualified Data.ByteString.Char8 as B (unpack)
11+import qualified Network.HTTP.Types as H
12+import Network.Wai.Handler.Warp.Types
13+import Prelude hiding (lines)
14+
15+import Criterion.Main
16+
17+-- $setup
18+-- >>> :set -XOverloadedStrings
19+
20+main :: IO ()
21+main = do
22+ let requestLine1 = "GET http://www.example.com HTTP/1.1"
23+ let requestLine2 = "GET http://www.example.com/cgi-path/search.cgi?key=parser HTTP/1.0"
24+ defaultMain [
25+ bgroup "requestLine1" [
26+ bench "parseRequestLine1" $ parseRequestLine1 requestLine1
27+ , bench "parseRequestLine0" $ parseRequestLine0 requestLine1
28+ ]
29+ , bgroup "requestLine2" [
30+ bench "parseRequestLine1" $ parseRequestLine1 requestLine2
31+ , bench "parseRequestLine0" $ parseRequestLine0 requestLine2
32+ ]
33+ ]
34+
35+----------------------------------------------------------------
36+
37+parseRequestLine2 :: ByteString
38+ -> IO (H.Method
39+ ,ByteString -- Path
40+ ,ByteString -- Query
41+ ,H.HttpVersion)
42+parseRequestLine2 requestLine = undefined
43+
44+----------------------------------------------------------------
45+
46+-- |
47+--
48+-- >>> parseRequestLine1 "GET / HTTP/1.1"
49+-- ("GET","/","",HTTP/1.1)
50+-- >>> parseRequestLine1 "POST /cgi/search.cgi?key=foo HTTP/1.0"
51+-- ("POST","/cgi/search.cgi","?key=foo",HTTP/1.0)
52+-- >>> parseRequestLine1 "GET /NoHTTPVersion"
53+-- *** Exception: BadFirstLine "GET /NoHTTPVersion"
54+-- >>> parseRequestLine1 "GET /NotHTTP UNKNOWN/1.1"
55+-- *** Exception: NonHttp
56+parseRequestLine1 :: ByteString
57+ -> IO (H.Method
58+ ,ByteString -- Path
59+ ,ByteString -- Query
60+ ,H.HttpVersion)
61+parseRequestLine1 requestLine = do
62+ let (!method,!rest) = S.breakByte 32 requestLine -- ' '
63+ (!pathQuery,!httpVer') = S.breakByte 32 (S.drop 1 rest) -- ' '
64+ !httpVer = S.drop 1 httpVer'
65+ when (rest == "" || httpVer == "") $
66+ throwIO $ BadFirstLine $ B.unpack requestLine
67+ let (!path,!query) = S.breakByte 63 pathQuery -- '?'
68+ (!http,!ver) = S.breakByte 47 httpVer -- '/'
69+ when (http /= "HTTP") $ throwIO NonHttp
70+ let !hv | ver == "/1.1" = H.http11
71+ | otherwise = H.http10
72+ return $! (method,path,query,hv)
73+
74+----------------------------------------------------------------
75+
76+parseRequestLine0 :: ByteString
77+ -> IO (H.Method
78+ ,ByteString -- Path
79+ ,ByteString -- Query
80+ ,H.HttpVersion)
81+parseRequestLine0 s =
82+ case filter (not . S.null) $ S.splitWith (\c -> c == 32 || c == 9) s of -- '
83+ (method':query:http'') -> do
84+ let !method = method'
85+ !http' = S.concat http''
86+ (!hfirst, !hsecond) = S.splitAt 5 http'
87+ if hfirst == "HTTP/"
88+ then let (!rpath, !qstring) = S.breakByte 63 query -- '?'
89+ !hv =
90+ case hsecond of
91+ "1.1" -> H.http11
92+ _ -> H.http10
93+ in return $! (method, rpath, qstring, hv)
94+ else throwIO NonHttp
95+ _ -> throwIO $ BadFirstLine $ B.unpack s
warp/warp.cabal+10
@@ -137,6 +137,16 @@ Test-Suite spec
137 --if os(windows)
137 --if os(windows)
138 -- Cpp-Options: -DWINDOWS
138 -- Cpp-Options: -DWINDOWS
139
139
140+Benchmark parser
141+ Type: exitcode-stdio-1.0
142+ Main-Is: Parser.hs
143+ HS-Source-Dirs: bench .
144+ Build-Depends: base
145+ , bytestring
146+ , criterion
147+ , http-types
148+ , network
149+
140Source-Repository head
150Source-Repository head
141 Type: git
151 Type: git
142 Location: git://github.com/yesodweb/wai.git
152 Location: git://github.com/yesodweb/wai.git