git.iko.soy/typeable/attoparsec
on master help sign in
typeable/attoparsec/benchmarks/Links.hs
63 lines 2.1 kB history raw
1{-# LANGUAGE OverloadedStrings #-}
3module Links (links) where
5import Control.Applicative
6import Control.DeepSeq (NFData(..))
7import Criterion.Main (Benchmark, bench, nf)
8import Data.Attoparsec.ByteString as A
9import Data.Attoparsec.ByteString.Char8 as A8
10import Data.ByteString.Char8 as B8
12data Link = Link {
13 linkURL :: ByteString
14 , linkParams :: [(ByteString, ByteString)]
15 } deriving (Eq, Show)
17instance NFData Link where
18 rnf l = rnf (linkURL l) `seq` rnf (linkParams l)
20link :: Parser Link
21link = Link <$> url <*> many (char8 ';' *> skipSpace *> param)
22 where url = char8 '<' *> A8.takeTill (=='>') <* char8 '>' <* skipSpace
24param :: Parser (ByteString, ByteString)
25param = do
26 name <- paramName
27 skipSpace *> "=" *> skipSpace
28 c <- peekChar'
29 let isTokenChar = A.inClass "!#$%&'()*+./0-9:<=>?@a-zA-Z[]^_`{|}~-"
30 val <- case c of
31 '"' -> quotedString
32 _ -> A.takeWhile isTokenChar
33 skipSpace
34 return (name, val)
36data Quot = Literal | Backslash
38quotedString :: Parser ByteString
39quotedString = char '"' *> (fixup <$> body) <* char '"'
40 where body = A8.scan Literal $ \s c ->
41 case (s,c) of
42 (Literal, '\\') -> backslash
43 (Literal, '"') -> Nothing
44 _ -> literal
45 literal = Just Literal
46 backslash = Just Backslash
47 fixup = B8.pack . go . B8.unpack
48 where go ('\\' : x@'\\' : xs) = x : go xs
49 go ('\\' : x@'"' : xs) = x : go xs
50 go (x : xs) = x : go xs
51 go xs = xs
53paramName :: Parser ByteString
54paramName = do
55 name <- A.takeWhile1 $ A.inClass "a-zA-Z0-9!#$&+-.^_`|~"
56 c <- peekChar
57 return $ case c of
58 Just '*' -> B8.snoc name '*'
59 _ -> name
61links :: Benchmark
62links = bench "links" $ nf (A.parseOnly link) lnk
63 where lnk = "<https://api.github.com/search/code?q=addClass+user%3Amozilla&page=2>; rel=\"next\", <https://api.github.com/search/code?q=addClass+user%3Amozilla&page=34>; rel=\"last\""