1. Bryan O'Sullivan
  2. attoparsec

Commits

Bryan O'Sullivan  committed ad7ba07

Improve performance of the Parsec craziness a bit.

  • Participants
  • Parent commits 93e5e1c
  • Branches default

Comments (0)

Files changed (1)

File examples/Parsec_RFC2616.hs

View file
 
 module Main (main) where
 
+import Control.Applicative
+import Control.Exception (bracket)
+import System.Environment (getArgs)
+import System.IO (hClose, openFile, IOMode(ReadMode))
+import Text.Parsec.ByteString (Parser, parseFromFile)
+import Text.Parsec.Char (anyChar, char, satisfy, string)
+import Text.Parsec.Combinator (many1, manyTill, skipMany1)
+import Text.Parsec.Prim hiding (many, token, (<|>))
 import qualified Data.ByteString as B
-import Control.Applicative
-import Control.Monad
-import System.IO
-import Control.Exception hiding (try)
-import System.Environment (getArgs)
-import Text.Parsec.ByteString
-import Text.Parsec.Char
-import Text.Parsec.Combinator
-import Text.Parsec.Prim hiding (many, token, (<|>))
+import qualified Data.IntSet as S
 
 token :: Stream s m Char => ParsecT s u m Char
-token = satisfy $ \c -> not (elem c (['\0'..'\31'] ++ "()<>@,;:\\\"/[]?={} \t" ++ ['\128'..'\255']))
+token = satisfy $ \c -> S.notMember (fromEnum c) set
+  where set = S.fromList . map fromEnum $ ['\0'..'\31'] ++ "()<>@,;:\\\"/[]?={} \t" ++ ['\128'..'\255']
 
 isHorizontalSpace c = c == ' ' || c == '\t'
 
 skipHSpaces :: Stream s m Char => ParsecT s u m ()
-{-# SPECIALISE skipHSpaces :: Parser () #-}
 skipHSpaces = skipMany1 (satisfy isHorizontalSpace)
 
 data Request = Request {
     } deriving (Eq, Ord, Show)
 
 requestLine :: Stream s m Char => ParsecT s u m Request
-{-# SPECIALISE requestLine :: Parser Request #-}
 requestLine = do
   method <- many1 token <* skipHSpaces
   uri <- many1 (satisfy (not . isHorizontalSpace)) <* skipHSpaces <* string "HTTP/"
   httpVersion = satisfy $ \c -> c == '1' || c == '0' || c == '.'
 
 endOfLine :: Stream s m Char => ParsecT s u m ()
-{-# SPECIALISE endOfLine :: Parser () #-}
 endOfLine = (string "\r\n" *> pure ()) <|> (char '\n' *> pure ())
 
 data Header = Header {
     } deriving (Eq, Ord, Show)
 
 messageHeader :: Stream s m Char => ParsecT s u m Header
-{-# SPECIALISE messageHeader :: Parser Header #-}
 messageHeader = do
   header <- many1 token <* char ':' <* skipHSpaces
-  body <- manyTill anyChar (try endOfLine)
-  conts <- many $ skipHSpaces *> manyTill anyChar (try endOfLine)
+  body <- manyTill anyChar endOfLine
+  conts <- many $ skipHSpaces *> manyTill anyChar endOfLine
   return $! Header header (body:conts)
 
 request :: Stream s m Char => ParsecT s u m (Request, [Header])
-{-# SPECIALISE request :: Parser (Request, [Header]) #-}
 request = (,) <$> requestLine <*> many messageHeader <* endOfLine
 
-main = mapM_ chunky =<< getArgs
-
 listy arg = do
   r <- parseFromFile (many request) arg
   case r of
   loop !n bs
       | B.null bs = print n
       | otherwise = case parse myReq arg bs of
-                      Left err -> putStrLn $ arg ++ ": " ++ show err
+                      Left err      -> putStrLn $ arg ++ ": " ++ show err
                       Right (r,bs') -> loop (n+1) bs'
   myReq :: Parser ((Request, [Header]), B.ByteString)
   myReq = liftA2 (,) request getInput
+
+main :: IO ()
+main = mapM_ f =<< getArgs
+  where
+    --f = listy
+    f = chunky