@@ -2,24 +2,24 @@
22
33module Main (main) where
44
5−import qualified Data.ByteString as B
65import Control.Applicative
7−import Control.Monad
8−import System.IO
9−import Control.Exception hiding (try)
6+import Control.Exception (bracket)
107import System.Environment (getArgs)
11−import Text.Parsec.ByteString
12−import Text.Parsec.Char
13−import Text.Parsec.Combinator
8+import System.IO (hClose, openFile, IOMode(ReadMode))
9+import Text.Parsec.ByteString (Parser, parseFromFile)
10+import Text.Parsec.Char (anyChar, char, satisfy, string)
11+import Text.Parsec.Combinator (many1, manyTill, skipMany1)
1412import Text.Parsec.Prim hiding (many, token, (<|>))
13+import qualified Data.ByteString as B
14+import qualified Data.IntSet as S
1515
1616token :: Stream s m Char => ParsecT s u m Char
17−token = satisfy $ \c -> not (elem c (['\0'..'\31'] ++ "()<>@,;:\\\"/[]?={} \t" ++ ['\128'..'\255']))
17+token = satisfy $ \c -> S.notMember (fromEnum c) set
18+ where set = S.fromList . map fromEnum $ ['\0'..'\31'] ++ "()<>@,;:\\\"/[]?={} \t" ++ ['\128'..'\255']
1819
1920isHorizontalSpace c = c == ' ' || c == '\t'
2021
2122skipHSpaces :: Stream s m Char => ParsecT s u m ()
22−{-# SPECIALISE skipHSpaces :: Parser () #-}
2323skipHSpaces = skipMany1 (satisfy isHorizontalSpace)
2424
2525data Request = Request {
@@ -29,7 +29,6 @@ data Request = Request {
2929 } deriving (Eq, Ord, Show)
3030
3131requestLine :: Stream s m Char => ParsecT s u m Request
32−{-# SPECIALISE requestLine :: Parser Request #-}
3332requestLine = do
3433 method <- many1 token <* skipHSpaces
3534 uri <- many1 (satisfy (not . isHorizontalSpace)) <* skipHSpaces <* string "HTTP/"
@@ -39,7 +38,6 @@ requestLine = do
3938 httpVersion = satisfy $ \c -> c == '1' || c == '0' || c == '.'
4039
4140endOfLine :: Stream s m Char => ParsecT s u m ()
42−{-# SPECIALISE endOfLine :: Parser () #-}
4341endOfLine = (string "\r\n" *> pure ()) <|> (char '\n' *> pure ())
4442
4543data Header = Header {
@@ -48,19 +46,15 @@ data Header = Header {
4846 } deriving (Eq, Ord, Show)
4947
5048messageHeader :: Stream s m Char => ParsecT s u m Header
51−{-# SPECIALISE messageHeader :: Parser Header #-}
5249messageHeader = do
5350 header <- many1 token <* char ':' <* skipHSpaces
54− body <- manyTill anyChar (try endOfLine)
55− conts <- many $ skipHSpaces *> manyTill anyChar (try endOfLine)
51+ body <- manyTill anyChar endOfLine
52+ conts <- many $ skipHSpaces *> manyTill anyChar endOfLine
5653 return $! Header header (body:conts)
5754
5855request :: Stream s m Char => ParsecT s u m (Request, [Header])
59−{-# SPECIALISE request :: Parser (Request, [Header]) #-}
6056request = (,) <$> requestLine <*> many messageHeader <* endOfLine
6157
62−main = mapM_ chunky =<< getArgs
63−
6458listy arg = do
6559 r <- parseFromFile (many request) arg
6660 case r of
@@ -73,7 +67,13 @@ chunky arg = bracket (openFile arg ReadMode) hClose $ \h ->
7367 loop !n bs
7468 | B.null bs = print n
7569 | otherwise = case parse myReq arg bs of
76− Left err -> putStrLn $ arg ++ ": " ++ show err
70+ Left err -> putStrLn $ arg ++ ": " ++ show err
7771 Right (r,bs') -> loop (n+1) bs'
7872 myReq :: Parser ((Request, [Header]), B.ByteString)
7973 myReq = liftA2 (,) request getInput
74+
75+main :: IO ()
76+main = mapM_ f =<< getArgs
77+ where
78+ --f = listy
79+ f = chunky