X-Git-Url: http://git.cielonegro.org/gitweb.cgi?p=Lucu.git;a=blobdiff_plain;f=Network%2FHTTP%2FLucu%2FParser%2FHttp.hs;h=015c189d1d26f789e87827a3bd4edfd0b31935c4;hp=ae09522b3807c65c6bca94dc6355727e52f81c38;hb=858129cb755aa09da2b7bd758efb8519f2c89103;hpb=5b255535f2c7d2a6d4622ad164b31e63746b906e diff --git a/Network/HTTP/Lucu/Parser/Http.hs b/Network/HTTP/Lucu/Parser/Http.hs index ae09522..015c189 100644 --- a/Network/HTTP/Lucu/Parser/Http.hs +++ b/Network/HTTP/Lucu/Parser/Http.hs @@ -26,11 +26,30 @@ 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 @@ -41,21 +60,23 @@ isChar c -- |@'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')+@