Skip to content

Commit

Permalink
Simplify RFC2616
Browse files Browse the repository at this point in the history
  • Loading branch information
bos committed May 31, 2014
1 parent abecf98 commit 7c46862
Showing 1 changed file with 18 additions and 18 deletions.
36 changes: 18 additions & 18 deletions examples/RFC2616.hs
Original file line number Diff line number Diff line change
Expand Up @@ -11,55 +11,55 @@ module RFC2616

import Control.Applicative
import Data.Attoparsec.ByteString as P
import qualified Data.Attoparsec.ByteString.Char8 as P8
import Data.Attoparsec.ByteString.Char8 (char8, endOfLine, isDigit_w8)
import Data.ByteString (ByteString)
import Data.Word (Word8)
import qualified Data.ByteString.Char8 as B
import Data.Attoparsec.ByteString.Char8 (isEndOfLine, isHorizontalSpace)

isToken :: Word8 -> Bool
isToken w = w <= 127 && notInClass "\0-\31()<>@,;:\\\"/[]?={} \t" w

skipSpaces :: Parser ()
skipSpaces = satisfy P8.isHorizontalSpace *> skipWhile P8.isHorizontalSpace
skipSpaces = satisfy isHorizontalSpace *> skipWhile isHorizontalSpace

data Request = Request {
requestMethod :: B.ByteString
, requestUri :: B.ByteString
, requestVersion :: B.ByteString
requestMethod :: ByteString
, requestUri :: ByteString
, requestVersion :: ByteString
} deriving (Eq, Ord, Show)

httpVersion :: Parser B.ByteString
httpVersion :: Parser ByteString
httpVersion = "HTTP/" *> P.takeWhile (\c -> isDigit_w8 c || c == 46)

requestLine :: Parser Request
requestLine = Request <$> (P.takeWhile1 isToken <* char8 ' ')
<*> (P.takeWhile1 (/=32) <* char8 ' ')
requestLine = Request <$> (takeWhile1 isToken <* char8 ' ')
<*> (takeWhile1 (/=32) <* char8 ' ')
<*> (httpVersion <* endOfLine)

data Header = Header {
headerName :: B.ByteString
, headerValue :: [B.ByteString]
headerName :: ByteString
, headerValue :: [ByteString]
} deriving (Eq, Ord, Show)

messageHeader :: Parser Header
messageHeader = Header
<$> (P.takeWhile isToken <* char8 ':' <* skipWhile P8.isHorizontalSpace)
<*> ((:) <$> (takeTill P8.isEndOfLine <* endOfLine)
<*> (many $ skipSpaces *> takeTill P8.isEndOfLine <* endOfLine))
<$> (P.takeWhile isToken <* char8 ':' <* skipWhile isHorizontalSpace)
<*> ((:) <$> (takeTill isEndOfLine <* endOfLine)
<*> (many $ skipSpaces *> takeTill isEndOfLine <* endOfLine))

request :: Parser (Request, [Header])
request = (,) <$> requestLine <*> many messageHeader <* endOfLine

data Response = Response {
responseVersion :: B.ByteString
, responseCode :: B.ByteString
, responseMsg :: B.ByteString
responseVersion :: ByteString
, responseCode :: ByteString
, responseMsg :: ByteString
} deriving (Eq, Ord, Show)

responseLine :: Parser Response
responseLine = Response <$> (httpVersion <* char8 ' ')
<*> (P.takeWhile isDigit_w8 <* char8 ' ')
<*> (P.takeTill P8.isEndOfLine <* endOfLine)
<*> (takeTill isEndOfLine <* endOfLine)

response :: Parser (Response, [Header])
response = (,) <$> responseLine <*> many messageHeader <* endOfLine

0 comments on commit 7c46862

Please sign in to comment.