module Text.ParserCombinators.Parsec.Rfc2234 where
import Text.ParserCombinators.Parsec
import Data.Char ( toUpper, chr, ord )
import Control.Monad ( liftM2 )
caseChar :: Char -> CharParser st Char
caseChar c = satisfy (\x -> toUpper x == toUpper c)
caseString :: String -> CharParser st ()
caseString cs = mapM_ caseChar cs <?> cs
manyN :: Int -> GenParser a b c -> GenParser a b [c]
manyN n p
| n <= 0 = return []
| otherwise = liftM2 (++) (count n p) (many p)
manyNtoM :: Int -> Int -> GenParser a b c -> GenParser a b [c]
manyNtoM n m p
| n < 0 = return []
| n > m = return []
| n == m = count n p
| n == 0 = do foldr (<|>) (return []) (map (\x -> try $ count x p) (reverse [1..m]))
| otherwise = liftM2 (++) (count n p) (manyNtoM 0 (mn) p)
parsec2read :: Parser a -> String -> [(a, String)]
parsec2read f x = either (error . show) id (parse f' "" x)
where
f' = do { a <- f; res <- getInput; return [(a,res)] }
alpha :: CharParser st Char
alpha = satisfy (\c -> c `elem` (['A'..'Z'] ++ ['a'..'z']))
<?> "alphabetic character"
bit :: CharParser st Char
bit = oneOf "01" <?> "bit ('0' or '1')"
character :: CharParser st Char
character = satisfy (\c -> (c >= chr 1) && (c <= chr 127))
<?> "7-bit character excluding NUL"
cr :: CharParser st Char
cr = char '\r' <?> "carriage return"
lf :: CharParser st Char
lf = char '\n' <?> "linefeed"
crlf :: CharParser st String
crlf = do c <- cr
l <- lf
return [c,l]
<?> "carriage return followed by linefeed"
ctl :: CharParser st Char
ctl = satisfy (\c -> ord c `elem` ([0..31] ++ [127]))
<?> "control character"
dquote :: CharParser st Char
dquote = char (chr 34) <?> "double quote"
hexdig :: CharParser st Char
hexdig = hexDigit <?> "hexadecimal digit"
htab :: CharParser st Char
htab = char '\t' <?> "horizontal tab"
lwsp :: CharParser st String
lwsp = do r <- choice
[ many1 wsp
, try (liftM2 (++) crlf (many1 wsp))
]
rs <- option [] lwsp
return (r ++ rs)
<?> "linear white-space"
octet :: CharParser st Char
octet = anyChar <?> "any 8-bit character"
sp :: CharParser st Char
sp = char ' ' <?> "space"
vchar :: CharParser st Char
vchar = satisfy (\c -> (c >= chr 33) && (c <= chr 126))
<?> "printable character"
wsp :: CharParser st Char
wsp = sp <|> htab <?> "white-space"
quoted_pair :: CharParser st String
quoted_pair = do char '\\'
r <- noneOf "\r\n"
return ['\\',r]
<?> "quoted pair"
quoted_string :: CharParser st String
quoted_string = do dquote
r <- many qcont
dquote
return ("\"" ++ concat r ++ "\"")
<?> "quoted string"
where
qtext = noneOf "\\\"\r\n"
qcont = (many1 qtext) <|> (quoted_pair)