/usr/share/doc/libghc-attoparsec-dev/examples/Parsec_RFC2616.hs is in libghc-attoparsec-dev 0.10.1.1-1.
This file is owned by root:root, with mode 0o644.
The actual contents of the file can be viewed below.
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 | {-# LANGUAGE BangPatterns, CPP, FlexibleContexts #-}
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.Char (anyChar, char, satisfy, string)
import Text.Parsec.Combinator (many1, manyTill, skipMany1)
import Text.Parsec.Prim hiding (many, token, (<|>))
import qualified Data.IntSet as S
#if 1
import Text.Parsec.ByteString.Lazy (Parser, parseFromFile)
import qualified Data.ByteString.Lazy as B
#else
import Text.Parsec.ByteString (Parser, parseFromFile)
import qualified Data.ByteString as B
#endif
token :: Stream s m Char => ParsecT s u m Char
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 ()
skipHSpaces = skipMany1 (satisfy isHorizontalSpace)
data Request = Request {
requestMethod :: String
, requestUri :: String
, requestProtocol :: String
} deriving (Eq, Ord, Show)
requestLine :: Stream s m Char => ParsecT s u m Request
requestLine = do
method <- many1 token <* skipHSpaces
uri <- many1 (satisfy (not . isHorizontalSpace)) <* skipHSpaces <* string "HTTP/"
proto <- many httpVersion <* endOfLine
return $! Request method uri proto
where
httpVersion = satisfy $ \c -> c == '1' || c == '0' || c == '.'
endOfLine :: Stream s m Char => ParsecT s u m ()
endOfLine = (string "\r\n" *> pure ()) <|> (char '\n' *> pure ())
data Header = Header {
headerName :: String
, headerValue :: [String]
} deriving (Eq, Ord, Show)
messageHeader :: Stream s m Char => ParsecT s u m Header
messageHeader = do
header <- many1 token <* char ':' <* skipHSpaces
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])
request = (,) <$> requestLine <*> many messageHeader <* endOfLine
listy arg = do
r <- parseFromFile (many request) arg
case r of
Left err -> putStrLn $ arg ++ ": " ++ show err
Right rs -> print (length rs)
chunky arg = bracket (openFile arg ReadMode) hClose $ \h ->
loop 0 =<< B.hGetContents h
where
loop !n bs
| B.null bs = print n
| otherwise = case parse myReq arg bs of
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
|