X-Git-Url: http://git.cielonegro.org/gitweb.cgi?a=blobdiff_plain;f=Network%2FHTTP%2FLucu%2FParser%2FHttp.hs;h=015c189d1d26f789e87827a3bd4edfd0b31935c4;hb=858129cb755aa09da2b7bd758efb8519f2c89103;hp=93fc14d9c80077cf3f2ba63270b215c8fc3f7442;hpb=c6b11025d1f81c668e9995e856b7bb34175230d3;p=Lucu.git diff --git a/Network/HTTP/Lucu/Parser/Http.hs b/Network/HTTP/Lucu/Parser/Http.hs index 93fc14d..015c189 100644 --- a/Network/HTTP/Lucu/Parser/Http.hs +++ b/Network/HTTP/Lucu/Parser/Http.hs @@ -1,14 +1,18 @@ +-- |This is an auxiliary parser utilities for parsing things related +-- on HTTP protocol. +-- +-- In general you don't have to use this module directly. module Network.HTTP.Lucu.Parser.Http - ( isCtl -- Char -> Bool - , isSeparator -- Char -> Bool - , isChar -- Char -> Bool - , isToken -- Char -> Bool - , listOf -- Parser a -> Parser [a] - , token -- Parser String - , lws -- Parser String - , text -- Parser Char - , separator -- Parser Char - , quotedStr -- Parser String + ( isCtl + , isSeparator + , isChar + , isToken + , listOf + , token + , lws + , text + , separator + , quotedStr ) where @@ -17,52 +21,80 @@ import Data.ByteString.Lazy.Char8 (ByteString) import Data.List import Network.HTTP.Lucu.Parser +-- |@'isCtl' c@ is True iff @0x20 <= @c@ < 0x7F@. isCtl :: Char -> Bool isCtl c | c < '\x1f' = True | c >= '\x7f' = True - | otherwise = False - + | otherwise = False +-- |@'isSeparator' c@ is True iff c is one of HTTP separators. isSeparator :: Char -> Bool -isSeparator c = elem c "()<>@,;:\\\"/[]?={} \t" - - +isSeparator '(' = True +isSeparator ')' = True +isSeparator '<' = True +isSeparator '>' = True +isSeparator '@' = True +isSeparator ',' = True +isSeparator ';' = True +isSeparator ':' = True +isSeparator '\\' = True +isSeparator '"' = True +isSeparator '/' = True +isSeparator '[' = True +isSeparator ']' = True +isSeparator '?' = True +isSeparator '=' = True +isSeparator '{' = True +isSeparator '}' = True +isSeparator ' ' = True +isSeparator '\t' = True +isSeparator _ = False + +-- |@'isChar' c@ is True iff @c <= 0x7f@. isChar :: Char -> Bool isChar c | c <= '\x7f' = True | otherwise = False - +-- |@'isToken' c@ is equivalent to @not ('isCtl' c || 'isSeparator' +-- c)@ isToken :: Char -> Bool -isToken c = not (isCtl c || isSeparator c) - +isToken c = c `seq` + not (isCtl c || isSeparator c) +-- |@'listOf' p@ is similar to @'Network.HTTP.Lucu.Parser.sepBy' p +-- ('Network.HTTP.Lucu.Parser.char' \',\')@ but it allows any +-- occurrences of LWS before and after each tokens. listOf :: Parser a -> Parser [a] -listOf p = do many lws - sepBy p (do many lws - char ',' - many lws) - - +listOf p = p `seq` + do many lws + sepBy p $! do many lws + char ',' + many lws + +-- |'token' is equivalent to @'Network.HTTP.Lucu.Parser.many1' $ +-- 'Network.HTTP.Lucu.Parser.satisfy' 'isToken'@ token :: Parser String -token = many1 $ satisfy isToken - +token = many1 $! satisfy isToken +-- |'lws' is an HTTP LWS: @'Network.HTTP.Lucu.Parser.crlf'? +-- ('Network.HTTP.Lucu.Parser.sp' | 'Network.HTTP.Lucu.Parser.ht')+@ lws :: Parser String lws = do s <- option "" crlf xs <- many1 (sp <|> ht) return (s ++ xs) - +-- |'text' accepts one character which doesn't satisfy 'isCtl'. text :: Parser Char text = satisfy (\ c -> not (isCtl c)) - +-- |'separator' accepts one character which satisfies 'isSeparator'. separator :: Parser Char separator = satisfy isSeparator - +-- |'quotedStr' accepts a string surrounded by double quotation +-- marks. Quotes can be escaped by backslashes. quotedStr :: Parser String quotedStr = do char '"' xs <- many (qdtext <|> quotedPair)