{-# LANGUAGE FlexibleContexts #-}
module Text.Parsec.Rfc2234
( caseChar, caseString
, manyN, manyNtoM
, alpha, bit, character, cr, lf, crlf, ctl, dquote, hexdig
, htab, lwsp, octet, sp, vchar, wsp
, quoted_pair, quoted_string
) where
import Control.Monad ( liftM2, replicateM )
import Data.Char ( toUpper, chr, ord )
import Text.Parsec hiding ( crlf )
{-# ANN module "HLint: ignore Use camelCase" #-}
caseChar :: Stream s m Char => Char -> ParsecT s u m Char
caseChar c = satisfy (\x -> toUpper x == toUpper c)
caseString :: Stream s m Char => String -> ParsecT s u m ()
caseString cs = mapM_ caseChar cs <?> cs
manyN :: Int -> ParsecT s u m a -> ParsecT s u m [a]
manyN n p | n <= 0 = return []
| otherwise = liftM2 (++) (replicateM n p) (many p)
manyNtoM :: Int -> Int -> ParsecT s u m a -> ParsecT s u m [a]
manyNtoM n m p
| n < 0 = return []
| n > m = return []
| n == m = replicateM n p
| n == 0 = foldr ((<|>) . (\x -> try (replicateM x p))) (return []) (reverse [1 .. m])
| otherwise = liftM2 (++) (replicateM n p) (manyNtoM 0 (m - n) p)
alpha :: Stream s m Char => ParsecT s u m Char
alpha = satisfy (\c -> c `elem` (['A' .. 'Z'] ++ ['a' .. 'z'])) <?> "alphabetic character"
bit :: Stream s m Char => ParsecT s u m Char
bit = oneOf "01" <?> "bit ('0' or '1')"
character :: Stream s m Char => ParsecT s u m Char
character = satisfy (\c -> (c >= chr 1) && (c <= chr 127)) <?> "7-bit character excluding NUL"
cr :: Stream s m Char => ParsecT s u m Char
cr = char '\r' <?> "carriage return"
lf :: Stream s m Char => ParsecT s u m Char
lf = char '\n' <?> "linefeed"
crlf :: Stream s m Char => ParsecT s u m String
crlf = do c <- cr
l <- lf
return [c, l]
<?> "carriage return followed by linefeed"
ctl :: Stream s m Char => ParsecT s u m Char
ctl = satisfy (\c -> ord c `elem` ([0 .. 31] ++ [127])) <?> "control character"
dquote :: Stream s m Char => ParsecT s u m Char
dquote = char (chr 34) <?> "double quote"
hexdig :: Stream s m Char => ParsecT s u m Char
hexdig = hexDigit <?> "hexadecimal digit"
htab :: Stream s m Char => ParsecT s u m Char
htab = char '\t' <?> "horizontal tab"
lwsp :: Stream s m Char => ParsecT s u m String
lwsp = do r <- choice [many1 wsp, try (liftM2 (++) crlf (many1 wsp))]
rs <- option [] lwsp
return (r ++ rs)
<?> "linear white-space"
octet :: Stream s m Char => ParsecT s u m Char
octet = anyChar <?> "any 8-bit character"
sp :: Stream s m Char => ParsecT s u m Char
sp = char ' ' <?> "space"
vchar :: Stream s m Char => ParsecT s u m Char
vchar = satisfy (\c -> (c >= chr 33) && (c <= chr 126)) <?> "printable character"
wsp :: Stream s m Char => ParsecT s u m Char
wsp = sp <|> htab <?> "white-space"
quoted_pair :: Stream s m Char => ParsecT s u m String
quoted_pair = do _ <- char '\\'
r <- noneOf "\r\n"
return ['\\', r]
<?> "quoted pair"
quoted_string :: Stream s m Char => ParsecT s u m String
quoted_string = do _ <- dquote
r <- many qcont
_ <- dquote
return ("\"" ++ concat r ++ "\"")
<?> "quoted string"
where
qtext = noneOf "\\\"\r\n"
qcont = many1 qtext <|> quoted_pair