module Network.HTTP.Lucu.Parser.Http
( isCtl
, isSeparator
, isChar
, isToken
, listOf
, token
, lws
, text
, separator
, quotedStr
, qvalue
)
where
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 = 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 (not . isCtl)
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)