git.iko.soy/typeable/attoparsec
on master help sign in
Parsec craziness.
b59bb00Bryan O'Sullivan
examples/Parsec_RFC2616.hsnew file+79
compare with master
unifiedsplit
@@ -0,0 +1,79 @@
1+{-# LANGUAGE BangPatterns, FlexibleContexts #-}
2+
3+module Main (main) where
4+
5+import qualified Data.ByteString as B
6+import Control.Applicative
7+import Control.Monad
8+import System.IO
9+import Control.Exception hiding (try)
10+import System.Environment (getArgs)
11+import Text.Parsec.ByteString
12+import Text.Parsec.Char
13+import Text.Parsec.Combinator
14+import Text.Parsec.Prim hiding (many, token, (<|>))
15+
16+token :: Stream s m Char => ParsecT s u m Char
17+token = satisfy $ \c -> not (elem c (['\0'..'\31'] ++ "()<>@,;:\\\"/[]?={} \t" ++ ['\128'..'\255']))
18+
19+isHorizontalSpace c = c == ' ' || c == '\t'
20+
21+skipHSpaces :: Stream s m Char => ParsecT s u m ()
22+{-# SPECIALISE skipHSpaces :: Parser () #-}
23+skipHSpaces = skipMany1 (satisfy isHorizontalSpace)
24+
25+data Request = Request {
26+ requestMethod :: String
27+ , requestUri :: String
28+ , requestProtocol :: String
29+ } deriving (Eq, Ord, Show)
30+
31+requestLine :: Stream s m Char => ParsecT s u m Request
32+{-# SPECIALISE requestLine :: Parser Request #-}
33+requestLine = do
34+ method <- many1 token <* skipHSpaces
35+ uri <- many1 (satisfy (not . isHorizontalSpace)) <* skipHSpaces <* string "HTTP/"
36+ proto <- many httpVersion <* endOfLine
37+ return $! Request method uri proto
38+ where
39+ httpVersion = satisfy $ \c -> c == '1' || c == '0' || c == '.'
40+
41+endOfLine :: Stream s m Char => ParsecT s u m ()
42+{-# SPECIALISE endOfLine :: Parser () #-}
43+endOfLine = (string "\r\n" *> pure ()) <|> (char '\n' *> pure ())
44+
45+data Header = Header {
46+ headerName :: String
47+ , headerValue :: [String]
48+ } deriving (Eq, Ord, Show)
49+
50+messageHeader :: Stream s m Char => ParsecT s u m Header
51+{-# SPECIALISE messageHeader :: Parser Header #-}
52+messageHeader = do
53+ header <- many1 token <* char ':' <* skipHSpaces
54+ body <- manyTill anyChar (try endOfLine)
55+ conts <- many $ skipHSpaces *> manyTill anyChar (try endOfLine)
56+ return $! Header header (body:conts)
57+
58+request :: Stream s m Char => ParsecT s u m (Request, [Header])
59+{-# SPECIALISE request :: Parser (Request, [Header]) #-}
60+request = (,) <$> requestLine <*> many messageHeader <* endOfLine
61+
62+main = mapM_ chunky =<< getArgs
63+
64+listy arg = do
65+ r <- parseFromFile (many request) arg
66+ case r of
67+ Left err -> putStrLn $ arg ++ ": " ++ show err
68+ Right rs -> print (length rs)
69+
70+chunky arg = bracket (openFile arg ReadMode) hClose $ \h ->
71+ loop 0 =<< B.hGetContents h
72+ where
73+ loop !n bs
74+ | B.null bs = print n
75+ | otherwise = case parse myReq arg bs of
76+ Left err -> putStrLn $ arg ++ ": " ++ show err
77+ Right (r,bs') -> loop (n+1) bs'
78+ myReq :: Parser ((Request, [Header]), B.ByteString)
79+ myReq = liftA2 (,) request getInput