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