module Happstack.Server.Internal.RFC822Headers
(
Header,
pHeader,
pHeaders,
parseHeaders,
ContentType(..),
getContentType,
parseContentType,
showContentType,
ContentTransferEncoding(..),
getContentTransferEncoding,
parseContentTransferEncoding,
ContentDisposition(..),
getContentDisposition,
parseContentDisposition,
parseM
) where
import Control.Monad
import Control.Monad.Fail (MonadFail)
import Data.Char
import Data.List
import Text.ParserCombinators.Parsec
type = (String, String)
pHeaders :: Parser [Header]
= forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many Parser Header
pHeader
parseHeaders :: MonadFail m => SourceName -> String -> m [Header]
= forall (m :: * -> *) a.
MonadFail m =>
Parser a -> String -> String -> m a
parseM Parser [Header]
pHeaders
pHeader :: Parser Header
=
do String
name <- forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m [a]
many1 Parser Char
headerNameChar
forall (f :: * -> *) a. Functor f => f a -> f ()
void forall a b. (a -> b) -> a -> b
$ forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
':'
forall (f :: * -> *) a. Functor f => f a -> f ()
void forall a b. (a -> b) -> a -> b
$ forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many Parser Char
ws1
String
line <- Parser String
lineString
forall (f :: * -> *) a. Functor f => f a -> f ()
void Parser String
crLf
[String]
extraLines <- forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many Parser String
extraFieldLine
forall (m :: * -> *) a. Monad m => a -> m a
return (forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
toLower String
name, forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat (String
lineforall a. a -> [a] -> [a]
:[String]
extraLines))
extraFieldLine :: Parser String
=
do Char
sp <- Parser Char
ws1
String
line <- Parser String
lineString
forall (f :: * -> *) a. Functor f => f a -> f ()
void forall a b. (a -> b) -> a -> b
$ Parser String
crLf
forall (m :: * -> *) a. Monad m => a -> m a
return (Char
spforall a. a -> [a] -> [a]
:String
line)
showParameters :: [(String,String)] -> String
showParameters :: [Header] -> String
showParameters = forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap forall {t :: * -> *}. Foldable t => (String, t Char) -> String
f
where f :: (String, t Char) -> String
f (String
n,t Char
v) = String
"; " forall a. [a] -> [a] -> [a]
++ String
n forall a. [a] -> [a] -> [a]
++ String
"=\"" forall a. [a] -> [a] -> [a]
++ forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Char -> String
esc t Char
v forall a. [a] -> [a] -> [a]
++ String
"\""
esc :: Char -> String
esc Char
'\\' = String
"\\\\"
esc Char
'"' = String
"\\\""
esc Char
c | Char
c forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Char
'\\',Char
'"'] = Char
'\\'forall a. a -> [a] -> [a]
:[Char
c]
| Bool
otherwise = [Char
c]
p_parameter :: Parser (String,String)
p_parameter :: Parser Header
p_parameter =
do forall (f :: * -> *) a. Functor f => f a -> f ()
void forall a b. (a -> b) -> a -> b
$ forall a. Parser a -> Parser a
lexeme forall a b. (a -> b) -> a -> b
$ forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
';'
String
p_name <- forall a. Parser a -> Parser a
lexeme forall a b. (a -> b) -> a -> b
$ Parser String
p_token
forall (f :: * -> *) a. Functor f => f a -> f ()
void forall a b. (a -> b) -> a -> b
$ forall a. Parser a -> Parser a
lexeme forall a b. (a -> b) -> a -> b
$ forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'='
let litStr :: Parser String
litStr = if String
p_name forall a. Eq a => a -> a -> Bool
== String
"filename"
then forall s (m :: * -> *) t u a.
Stream s m t =>
[ParsecT s u m a] -> ParsecT s u m a
choice [ forall tok st a. GenParser tok st a -> GenParser tok st a
try ((forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m a
lookAhead forall a b. (a -> b) -> a -> b
$ do
forall (f :: * -> *) a. Functor f => f a -> f ()
void (Parser String
literalString forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>
Parser Header
p_parameter))
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Parser String
literalString)
, Parser String
buggyLiteralString]
else Parser String
literalString
String
p_value <- Parser String
litStr forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> Parser String
p_token
forall (m :: * -> *) a. Monad m => a -> m a
return (forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
toLower String
p_name, String
p_value)
data ContentType =
ContentType {
ContentType -> String
ctType :: String,
ContentType -> String
ctSubtype :: String,
ContentType -> [Header]
ctParameters :: [(String, String)]
}
deriving (Int -> ContentType -> ShowS
[ContentType] -> ShowS
ContentType -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ContentType] -> ShowS
$cshowList :: [ContentType] -> ShowS
show :: ContentType -> String
$cshow :: ContentType -> String
showsPrec :: Int -> ContentType -> ShowS
$cshowsPrec :: Int -> ContentType -> ShowS
Show, ReadPrec [ContentType]
ReadPrec ContentType
Int -> ReadS ContentType
ReadS [ContentType]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ContentType]
$creadListPrec :: ReadPrec [ContentType]
readPrec :: ReadPrec ContentType
$creadPrec :: ReadPrec ContentType
readList :: ReadS [ContentType]
$creadList :: ReadS [ContentType]
readsPrec :: Int -> ReadS ContentType
$creadsPrec :: Int -> ReadS ContentType
Read, ContentType -> ContentType -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ContentType -> ContentType -> Bool
$c/= :: ContentType -> ContentType -> Bool
== :: ContentType -> ContentType -> Bool
$c== :: ContentType -> ContentType -> Bool
Eq, Eq ContentType
ContentType -> ContentType -> Bool
ContentType -> ContentType -> Ordering
ContentType -> ContentType -> ContentType
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: ContentType -> ContentType -> ContentType
$cmin :: ContentType -> ContentType -> ContentType
max :: ContentType -> ContentType -> ContentType
$cmax :: ContentType -> ContentType -> ContentType
>= :: ContentType -> ContentType -> Bool
$c>= :: ContentType -> ContentType -> Bool
> :: ContentType -> ContentType -> Bool
$c> :: ContentType -> ContentType -> Bool
<= :: ContentType -> ContentType -> Bool
$c<= :: ContentType -> ContentType -> Bool
< :: ContentType -> ContentType -> Bool
$c< :: ContentType -> ContentType -> Bool
compare :: ContentType -> ContentType -> Ordering
$ccompare :: ContentType -> ContentType -> Ordering
Ord)
showContentType :: ContentType -> String
showContentType :: ContentType -> String
showContentType (ContentType String
x String
y [Header]
ps) = String
x forall a. [a] -> [a] -> [a]
++ String
"/" forall a. [a] -> [a] -> [a]
++ String
y forall a. [a] -> [a] -> [a]
++ [Header] -> String
showParameters [Header]
ps
pContentType :: Parser ContentType
pContentType :: Parser ContentType
pContentType =
do forall (f :: * -> *) a. Functor f => f a -> f ()
void forall a b. (a -> b) -> a -> b
$ forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many Parser Char
ws1
String
c_type <- Parser String
p_token
forall (f :: * -> *) a. Functor f => f a -> f ()
void forall a b. (a -> b) -> a -> b
$ forall a. Parser a -> Parser a
lexeme forall a b. (a -> b) -> a -> b
$ forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'/'
String
c_subtype <- forall a. Parser a -> Parser a
lexeme forall a b. (a -> b) -> a -> b
$ Parser String
p_token
[Header]
c_parameters <- forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many Parser Header
p_parameter
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ String -> String -> [Header] -> ContentType
ContentType (forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
toLower String
c_type) (forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
toLower String
c_subtype) [Header]
c_parameters
parseContentType :: MonadFail m => String -> m ContentType
parseContentType :: forall (m :: * -> *). MonadFail m => String -> m ContentType
parseContentType = forall (m :: * -> *) a.
MonadFail m =>
Parser a -> String -> String -> m a
parseM Parser ContentType
pContentType String
"Content-type"
getContentType :: MonadFail m => [Header] -> m ContentType
getContentType :: forall (m :: * -> *). MonadFail m => [Header] -> m ContentType
getContentType [Header]
hs = forall (m :: * -> *) a b.
(MonadFail m, Eq a, Show a) =>
a -> [(a, b)] -> m b
lookupM String
"content-type" [Header]
hs forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall (m :: * -> *). MonadFail m => String -> m ContentType
parseContentType
data ContentTransferEncoding =
ContentTransferEncoding String
deriving (Int -> ContentTransferEncoding -> ShowS
[ContentTransferEncoding] -> ShowS
ContentTransferEncoding -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ContentTransferEncoding] -> ShowS
$cshowList :: [ContentTransferEncoding] -> ShowS
show :: ContentTransferEncoding -> String
$cshow :: ContentTransferEncoding -> String
showsPrec :: Int -> ContentTransferEncoding -> ShowS
$cshowsPrec :: Int -> ContentTransferEncoding -> ShowS
Show, ReadPrec [ContentTransferEncoding]
ReadPrec ContentTransferEncoding
Int -> ReadS ContentTransferEncoding
ReadS [ContentTransferEncoding]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ContentTransferEncoding]
$creadListPrec :: ReadPrec [ContentTransferEncoding]
readPrec :: ReadPrec ContentTransferEncoding
$creadPrec :: ReadPrec ContentTransferEncoding
readList :: ReadS [ContentTransferEncoding]
$creadList :: ReadS [ContentTransferEncoding]
readsPrec :: Int -> ReadS ContentTransferEncoding
$creadsPrec :: Int -> ReadS ContentTransferEncoding
Read, ContentTransferEncoding -> ContentTransferEncoding -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ContentTransferEncoding -> ContentTransferEncoding -> Bool
$c/= :: ContentTransferEncoding -> ContentTransferEncoding -> Bool
== :: ContentTransferEncoding -> ContentTransferEncoding -> Bool
$c== :: ContentTransferEncoding -> ContentTransferEncoding -> Bool
Eq, Eq ContentTransferEncoding
ContentTransferEncoding -> ContentTransferEncoding -> Bool
ContentTransferEncoding -> ContentTransferEncoding -> Ordering
ContentTransferEncoding
-> ContentTransferEncoding -> ContentTransferEncoding
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: ContentTransferEncoding
-> ContentTransferEncoding -> ContentTransferEncoding
$cmin :: ContentTransferEncoding
-> ContentTransferEncoding -> ContentTransferEncoding
max :: ContentTransferEncoding
-> ContentTransferEncoding -> ContentTransferEncoding
$cmax :: ContentTransferEncoding
-> ContentTransferEncoding -> ContentTransferEncoding
>= :: ContentTransferEncoding -> ContentTransferEncoding -> Bool
$c>= :: ContentTransferEncoding -> ContentTransferEncoding -> Bool
> :: ContentTransferEncoding -> ContentTransferEncoding -> Bool
$c> :: ContentTransferEncoding -> ContentTransferEncoding -> Bool
<= :: ContentTransferEncoding -> ContentTransferEncoding -> Bool
$c<= :: ContentTransferEncoding -> ContentTransferEncoding -> Bool
< :: ContentTransferEncoding -> ContentTransferEncoding -> Bool
$c< :: ContentTransferEncoding -> ContentTransferEncoding -> Bool
compare :: ContentTransferEncoding -> ContentTransferEncoding -> Ordering
$ccompare :: ContentTransferEncoding -> ContentTransferEncoding -> Ordering
Ord)
pContentTransferEncoding :: Parser ContentTransferEncoding
pContentTransferEncoding :: Parser ContentTransferEncoding
pContentTransferEncoding =
do forall (f :: * -> *) a. Functor f => f a -> f ()
void forall a b. (a -> b) -> a -> b
$ forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many Parser Char
ws1
String
c_cte <- Parser String
p_token
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ String -> ContentTransferEncoding
ContentTransferEncoding (forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
toLower String
c_cte)
parseContentTransferEncoding :: MonadFail m => String -> m ContentTransferEncoding
parseContentTransferEncoding :: forall (m :: * -> *).
MonadFail m =>
String -> m ContentTransferEncoding
parseContentTransferEncoding =
forall (m :: * -> *) a.
MonadFail m =>
Parser a -> String -> String -> m a
parseM Parser ContentTransferEncoding
pContentTransferEncoding String
"Content-transfer-encoding"
getContentTransferEncoding :: MonadFail m => [Header] -> m ContentTransferEncoding
getContentTransferEncoding :: forall (m :: * -> *).
MonadFail m =>
[Header] -> m ContentTransferEncoding
getContentTransferEncoding [Header]
hs =
forall (m :: * -> *) a b.
(MonadFail m, Eq a, Show a) =>
a -> [(a, b)] -> m b
lookupM String
"content-transfer-encoding" [Header]
hs forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall (m :: * -> *).
MonadFail m =>
String -> m ContentTransferEncoding
parseContentTransferEncoding
data ContentDisposition =
ContentDisposition String [(String, String)]
deriving (Int -> ContentDisposition -> ShowS
[ContentDisposition] -> ShowS
ContentDisposition -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ContentDisposition] -> ShowS
$cshowList :: [ContentDisposition] -> ShowS
show :: ContentDisposition -> String
$cshow :: ContentDisposition -> String
showsPrec :: Int -> ContentDisposition -> ShowS
$cshowsPrec :: Int -> ContentDisposition -> ShowS
Show, ReadPrec [ContentDisposition]
ReadPrec ContentDisposition
Int -> ReadS ContentDisposition
ReadS [ContentDisposition]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ContentDisposition]
$creadListPrec :: ReadPrec [ContentDisposition]
readPrec :: ReadPrec ContentDisposition
$creadPrec :: ReadPrec ContentDisposition
readList :: ReadS [ContentDisposition]
$creadList :: ReadS [ContentDisposition]
readsPrec :: Int -> ReadS ContentDisposition
$creadsPrec :: Int -> ReadS ContentDisposition
Read, ContentDisposition -> ContentDisposition -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ContentDisposition -> ContentDisposition -> Bool
$c/= :: ContentDisposition -> ContentDisposition -> Bool
== :: ContentDisposition -> ContentDisposition -> Bool
$c== :: ContentDisposition -> ContentDisposition -> Bool
Eq, Eq ContentDisposition
ContentDisposition -> ContentDisposition -> Bool
ContentDisposition -> ContentDisposition -> Ordering
ContentDisposition -> ContentDisposition -> ContentDisposition
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: ContentDisposition -> ContentDisposition -> ContentDisposition
$cmin :: ContentDisposition -> ContentDisposition -> ContentDisposition
max :: ContentDisposition -> ContentDisposition -> ContentDisposition
$cmax :: ContentDisposition -> ContentDisposition -> ContentDisposition
>= :: ContentDisposition -> ContentDisposition -> Bool
$c>= :: ContentDisposition -> ContentDisposition -> Bool
> :: ContentDisposition -> ContentDisposition -> Bool
$c> :: ContentDisposition -> ContentDisposition -> Bool
<= :: ContentDisposition -> ContentDisposition -> Bool
$c<= :: ContentDisposition -> ContentDisposition -> Bool
< :: ContentDisposition -> ContentDisposition -> Bool
$c< :: ContentDisposition -> ContentDisposition -> Bool
compare :: ContentDisposition -> ContentDisposition -> Ordering
$ccompare :: ContentDisposition -> ContentDisposition -> Ordering
Ord)
pContentDisposition :: Parser ContentDisposition
pContentDisposition :: Parser ContentDisposition
pContentDisposition =
do forall (f :: * -> *) a. Functor f => f a -> f ()
void forall a b. (a -> b) -> a -> b
$ forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many Parser Char
ws1
String
c_cd <- Parser String
p_token
[Header]
c_parameters <- forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many Parser Header
p_parameter
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ String -> [Header] -> ContentDisposition
ContentDisposition (forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
toLower String
c_cd) [Header]
c_parameters
parseContentDisposition :: MonadFail m => String -> m ContentDisposition
parseContentDisposition :: forall (m :: * -> *). MonadFail m => String -> m ContentDisposition
parseContentDisposition = forall (m :: * -> *) a.
MonadFail m =>
Parser a -> String -> String -> m a
parseM Parser ContentDisposition
pContentDisposition String
"Content-disposition"
getContentDisposition :: MonadFail m => [Header] -> m ContentDisposition
getContentDisposition :: forall (m :: * -> *).
MonadFail m =>
[Header] -> m ContentDisposition
getContentDisposition [Header]
hs =
forall (m :: * -> *) a b.
(MonadFail m, Eq a, Show a) =>
a -> [(a, b)] -> m b
lookupM String
"content-disposition" [Header]
hs forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall (m :: * -> *). MonadFail m => String -> m ContentDisposition
parseContentDisposition
parseM :: MonadFail m => Parser a -> SourceName -> String -> m a
parseM :: forall (m :: * -> *) a.
MonadFail m =>
Parser a -> String -> String -> m a
parseM Parser a
p String
n String
inp =
case forall s t a.
Stream s Identity t =>
Parsec s () a -> String -> s -> Either ParseError a
parse Parser a
p String
n String
inp of
Left ParseError
e -> forall (m :: * -> *) a. MonadFail m => String -> m a
fail (forall a. Show a => a -> String
show ParseError
e)
Right a
x -> forall (m :: * -> *) a. Monad m => a -> m a
return a
x
lookupM :: (MonadFail m, Eq a, Show a) => a -> [(a,b)] -> m b
lookupM :: forall (m :: * -> *) a b.
(MonadFail m, Eq a, Show a) =>
a -> [(a, b)] -> m b
lookupM a
n = forall b a. b -> (a -> b) -> Maybe a -> b
maybe (forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String
"No such field: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show a
n)) forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup a
n
ws1 :: Parser Char
ws1 :: Parser Char
ws1 = forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m Char
oneOf String
" \t"
lexeme :: Parser a -> Parser a
lexeme :: forall a. Parser a -> Parser a
lexeme Parser a
p = do a
x <- Parser a
p; forall (f :: * -> *) a. Functor f => f a -> f ()
void forall a b. (a -> b) -> a -> b
$ forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many Parser Char
ws1; forall (m :: * -> *) a. Monad m => a -> m a
return a
x
crLf :: Parser String
crLf :: Parser String
crLf = forall tok st a. GenParser tok st a -> GenParser tok st a
try (forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
string String
"\n\r" forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
string String
"\r\n") forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
string String
"\n" forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
string String
"\r"
lineString :: Parser String
lineString :: Parser String
lineString = forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many (forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m Char
noneOf String
"\n\r")
literalString :: Parser String
literalString :: Parser String
literalString = do forall (f :: * -> *) a. Functor f => f a -> f ()
void forall a b. (a -> b) -> a -> b
$ forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'\"'
String
str <- forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many (forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m Char
noneOf String
"\"\\" forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> Parser Char
quoted_pair)
forall (f :: * -> *) a. Functor f => f a -> f ()
void forall a b. (a -> b) -> a -> b
$ forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'\"'
forall (m :: * -> *) a. Monad m => a -> m a
return String
str
buggyLiteralString :: Parser String
buggyLiteralString :: Parser String
buggyLiteralString =
do forall (f :: * -> *) a. Functor f => f a -> f ()
void forall a b. (a -> b) -> a -> b
$ forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'\"'
String
str <- forall s (m :: * -> *) t u a end.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m end -> ParsecT s u m [a]
manyTill forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
anyChar (forall tok st a. GenParser tok st a -> GenParser tok st a
try forall {u}. ParsecT String u Identity ()
lastQuote)
forall (m :: * -> *) a. Monad m => a -> m a
return String
str
where lastQuote :: ParsecT String u Identity ()
lastQuote = do forall (f :: * -> *) a. Functor f => f a -> f ()
void forall a b. (a -> b) -> a -> b
$ forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'\"'
forall s (m :: * -> *) t a u.
(Stream s m t, Show a) =>
ParsecT s u m a -> ParsecT s u m ()
notFollowedBy (forall tok st a. GenParser tok st a -> GenParser tok st a
try (forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many (forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m Char
noneOf String
"\"") forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'\"'))
headerNameChar :: Parser Char
= forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m Char
noneOf String
"\n\r:"
tspecials, tokenchar :: [Char]
tspecials :: String
tspecials = String
"()<>@,;:\\\"/[]?="
tokenchar :: String
tokenchar = String
"!\"#$%&'()*+,-./0123456789:;<=>?@ABCDEFGHIJKLMNOPQRSTUVWXYZ[\\]^_`abcdefghijklmnopqrstuvwxyz{|}~" forall a. Eq a => [a] -> [a] -> [a]
\\ String
tspecials
p_token :: Parser String
p_token :: Parser String
p_token = forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m [a]
many1 (forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m Char
oneOf String
tokenchar)
text_chars :: [Char]
text_chars :: String
text_chars = forall a b. (a -> b) -> [a] -> [b]
map Int -> Char
chr ([Int
1..Int
9] forall a. [a] -> [a] -> [a]
++ [Int
11,Int
12] forall a. [a] -> [a] -> [a]
++ [Int
14..Int
127])
p_text :: Parser Char
p_text :: Parser Char
p_text = forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m Char
oneOf String
text_chars
quoted_pair :: Parser Char
quoted_pair :: Parser Char
quoted_pair = do forall (f :: * -> *) a. Functor f => f a -> f ()
void forall a b. (a -> b) -> a -> b
$ forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'\\'
Parser Char
p_text