module Network.HTTP.Lucu.Parser.Http
( isCtl
, isSeparator
, isChar
, isToken
, listOf
, token
, lws
, text
, separator
, quotedStr
, qvalue
)
where
import Data.List
import Network.HTTP.Lucu.Parser
isCtl :: Char -> Bool
isCtl c
| c < '\x1f' = True
| c >= '\x7f' = True
| otherwise = False
isSeparator :: Char -> Bool
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 :: Char -> Bool
isChar c
| c <= '\x7f' = True
| otherwise = False
isToken :: Char -> Bool
isToken c = c `seq`
not (isCtl c || isSeparator c)
listOf :: Parser a -> Parser [a]
listOf p = p `seq`
do many lws
sepBy p $! do many lws
char ','
many lws
token :: Parser String
token = many1 $! satisfy isToken
lws :: Parser String
lws = do s <- option "" crlf
xs <- many1 (sp <|> ht)
return (s ++ xs)
text :: Parser Char
text = satisfy (\ c -> not (isCtl c))
separator :: Parser Char
separator = satisfy isSeparator
quotedStr :: Parser String
quotedStr = do char '"'
xs <- many (qdtext <|> quotedPair)
char '"'
return $ foldr (++) "" xs
where
qdtext = do c <- satisfy (/= '"')
return [c]
quotedPair = do char '\\'
c <- satisfy isChar
return [c]
qvalue :: Parser Double
qvalue = do x <- char '0'
xs <- option ""
$ do y <- char '.'
ys <- many digit
return (y:ys)
return $ read (x:xs)
<|>
do x <- char '1'
xs <- option ""
$ do y <- char '.'
ys <- many (char '0')
return (y:ys)
return $ read (x:xs)