@@ -0,0 +1,63 @@
1+{-# LANGUAGE OverloadedStrings #-}
2+
3+module Links (links) where
4+
5+import Control.Applicative
6+import Control.DeepSeq (NFData(..))
7+import Criterion.Main (Benchmark, bench, nf)
8+import Data.Attoparsec as A
9+import Data.Attoparsec.Char8 as A8
10+import Data.ByteString.Char8 as B8
11+
12+data Link = Link {
13+ linkURL :: ByteString
14+ , linkParams :: [(ByteString, ByteString)]
15+ } deriving (Eq, Show)
16+
17+instance NFData Link where
18+ rnf l = rnf (linkURL l) `seq` rnf (linkParams l)
19+
20+link :: Parser Link
21+link = Link <$> url <*> many (char8 ';' *> skipSpace *> param)
22+ where url = char8 '<' *> A8.takeTill (=='>') <* char8 '>' <* skipSpace
23+
24+param :: Parser (ByteString, ByteString)
25+param = 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)
35+
36+data Quot = Literal | Backslash
37+
38+quotedString :: Parser ByteString
39+quotedString = 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
52+
53+paramName :: Parser ByteString
54+paramName = 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
60+
61+links :: Benchmark
62+links = 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\""