git.iko.soy/typeable/attoparsec
on master help sign in
typeable/attoparsec/examples/RFC2616.hs
65 lines 2.1 kB history raw
1{-# LANGUAGE OverloadedStrings #-}
3module RFC2616
4 (
5 Header(..)
6 , Request(..)
7 , Response(..)
8 , request
9 , response
10 ) where
12import Control.Applicative
13import Data.Attoparsec.ByteString as P
14import Data.Attoparsec.ByteString.Char8 (char8, endOfLine, isDigit_w8)
15import Data.ByteString (ByteString)
16import Data.Word (Word8)
17import Data.Attoparsec.ByteString.Char8 (isEndOfLine, isHorizontalSpace)
19isToken :: Word8 -> Bool
20isToken w = w <= 127 && notInClass "\0-\31()<>@,;:\\\"/[]?={} \t" w
22skipSpaces :: Parser ()
23skipSpaces = satisfy isHorizontalSpace *> skipWhile isHorizontalSpace
25data Request = Request {
26 requestMethod :: ByteString
27 , requestUri :: ByteString
28 , requestVersion :: ByteString
29 } deriving (Eq, Ord, Show)
31httpVersion :: Parser ByteString
32httpVersion = "HTTP/" *> P.takeWhile (\c -> isDigit_w8 c || c == 46)
34requestLine :: Parser Request
35requestLine = Request <$> (takeWhile1 isToken <* char8 ' ')
36 <*> (takeWhile1 (/=32) <* char8 ' ')
37 <*> (httpVersion <* endOfLine)
39data Header = Header {
40 headerName :: ByteString
41 , headerValue :: [ByteString]
42 } deriving (Eq, Ord, Show)
44messageHeader :: Parser Header
45messageHeader = Header
46 <$> (P.takeWhile isToken <* char8 ':' <* skipWhile isHorizontalSpace)
47 <*> ((:) <$> (takeTill isEndOfLine <* endOfLine)
48 <*> (many $ skipSpaces *> takeTill isEndOfLine <* endOfLine))
50request :: Parser (Request, [Header])
51request = (,) <$> requestLine <*> many messageHeader <* endOfLine
53data Response = Response {
54 responseVersion :: ByteString
55 , responseCode :: ByteString
56 , responseMsg :: ByteString
57 } deriving (Eq, Ord, Show)
59responseLine :: Parser Response
60responseLine = Response <$> (httpVersion <* char8 ' ')
61 <*> (P.takeWhile isDigit_w8 <* char8 ' ')
62 <*> (takeTill isEndOfLine <* endOfLine)
64response :: Parser (Response, [Header])
65response = (,) <$> responseLine <*> many messageHeader <* endOfLine