module Network.Multipart.Header (
Headers,
HeaderName(..),
HeaderValue(..),
pHeaders,
ContentType(..),
getContentType,
parseContentType,
showContentType,
ContentTransferEncoding(..),
getContentTransferEncoding,
ContentDisposition(..),
getContentDisposition,
parseM,
caseInsensitiveEq,
caseInsensitiveCompare,
lexeme, ws1, p_token
) where
import Control.Monad
import Control.Monad.Fail as MFail
import Data.Char
import Data.List
import qualified Data.Monoid as M
import Text.ParserCombinators.Parsec
type = [(HeaderName, String)]
newtype = String deriving (Int -> HeaderName -> ShowS
[HeaderName] -> ShowS
HeaderName -> String
(Int -> HeaderName -> ShowS)
-> (HeaderName -> String)
-> ([HeaderName] -> ShowS)
-> Show HeaderName
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> HeaderName -> ShowS
showsPrec :: Int -> HeaderName -> ShowS
$cshow :: HeaderName -> String
show :: HeaderName -> String
$cshowList :: [HeaderName] -> ShowS
showList :: [HeaderName] -> ShowS
Show)
instance Eq HeaderName where
HeaderName String
x == :: HeaderName -> HeaderName -> Bool
== HeaderName String
y = (Char -> Char) -> ShowS
forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
toLower String
x String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== (Char -> Char) -> ShowS
forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
toLower String
y
instance Ord HeaderName where
HeaderName String
x compare :: HeaderName -> HeaderName -> Ordering
`compare` HeaderName String
y = (Char -> Char) -> ShowS
forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
toLower String
x String -> String -> Ordering
forall a. Ord a => a -> a -> Ordering
`compare` (Char -> Char) -> ShowS
forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
toLower String
y
class a where
:: Parser a
:: a -> String
pHeaders :: Parser Headers
= ParsecT String () Identity (HeaderName, String) -> Parser Headers
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many ParsecT String () Identity (HeaderName, String)
pHeader
pHeader :: Parser (HeaderName, String)
=
do String
name <- ParsecT String () Identity Char
-> ParsecT String () Identity String
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m [a]
many1 ParsecT String () Identity Char
headerNameChar
Char
_ <- Char -> ParsecT String () Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
':'
String
_ <- ParsecT String () Identity Char
-> ParsecT String () Identity String
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many ParsecT String () Identity Char
ws1
String
line <- ParsecT String () Identity String
lineString
String
_ <- ParsecT String () Identity String
crLf
[String]
extraLines <- ParsecT String () Identity String
-> ParsecT String () Identity [String]
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many ParsecT String () Identity String
extraFieldLine
(HeaderName, String)
-> ParsecT String () Identity (HeaderName, String)
forall a. a -> ParsecT String () Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (String -> HeaderName
HeaderName String
name, [String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat (String
lineString -> [String] -> [String]
forall a. a -> [a] -> [a]
:[String]
extraLines))
extraFieldLine :: Parser String
=
do Char
sp <- ParsecT String () Identity Char
ws1
String
line <- ParsecT String () Identity String
lineString
String
_ <- ParsecT String () Identity String
crLf
String -> ParsecT String () Identity String
forall a. a -> ParsecT String () Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (Char
spChar -> ShowS
forall a. a -> [a] -> [a]
:String
line)
getHeaderValue :: (MonadFail m, HeaderValue a) => String -> Headers -> m a
String
h Headers
hs = HeaderName -> Headers -> m String
forall (m :: * -> *) a b.
(MonadFail m, Eq a, Show a) =>
a -> [(a, b)] -> m b
lookupM (String -> HeaderName
HeaderName String
h) Headers
hs m String -> (String -> m a) -> m a
forall a b. m a -> (a -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Parser a -> String -> String -> m a
forall (m :: * -> *) a.
MonadFail m =>
Parser a -> String -> String -> m a
parseM Parser a
forall a. HeaderValue a => Parser a
parseHeaderValue String
h
showParameters :: [(String,String)] -> String
showParameters :: [(String, String)] -> String
showParameters = ((String, String) -> String) -> [(String, String)] -> String
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (String, String) -> String
forall {t :: * -> *}. Foldable t => (String, t Char) -> String
f
where f :: (String, t Char) -> String
f (String
n,t Char
v) = String
"; " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
n String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"=\"" String -> ShowS
forall a. [a] -> [a] -> [a]
++ (Char -> String) -> t Char -> String
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Char -> String
esc t Char
v String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"\""
esc :: Char -> String
esc Char
'\\' = String
"\\\\"
esc Char
'"' = String
"\\\""
esc 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
'\\',Char
'"'] = Char
'\\'Char -> ShowS
forall a. a -> [a] -> [a]
:[Char
c]
| Bool
otherwise = [Char
c]
p_parameter :: Parser (String,String)
p_parameter :: Parser (String, String)
p_parameter = Parser (String, String) -> Parser (String, String)
forall tok st a. GenParser tok st a -> GenParser tok st a
try (Parser (String, String) -> Parser (String, String))
-> Parser (String, String) -> Parser (String, String)
forall a b. (a -> b) -> a -> b
$
do Char
_ <- ParsecT String () Identity Char -> ParsecT String () Identity Char
forall a. Parser a -> Parser a
lexeme (ParsecT String () Identity Char
-> ParsecT String () Identity Char)
-> ParsecT String () Identity Char
-> ParsecT String () Identity Char
forall a b. (a -> b) -> a -> b
$ Char -> ParsecT String () Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
';'
String
p_name <- ParsecT String () Identity String
-> ParsecT String () Identity String
forall a. Parser a -> Parser a
lexeme (ParsecT String () Identity String
-> ParsecT String () Identity String)
-> ParsecT String () Identity String
-> ParsecT String () Identity String
forall a b. (a -> b) -> a -> b
$ ParsecT String () Identity String
p_token
Bool
-> ParsecT String () Identity () -> ParsecT String () Identity ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (String
p_name String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"q") ParsecT String () Identity ()
forall tok st a. GenParser tok st a
pzero
Char
_ <- ParsecT String () Identity Char -> ParsecT String () Identity Char
forall a. Parser a -> Parser a
lexeme (ParsecT String () Identity Char
-> ParsecT String () Identity Char)
-> ParsecT String () Identity Char
-> ParsecT String () Identity Char
forall a b. (a -> b) -> a -> b
$ Char -> ParsecT String () Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'='
let litStr :: ParsecT String () Identity String
litStr = if String
p_name String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"filename"
then ParsecT String () Identity String
buggyLiteralString
else ParsecT String () Identity String
literalString
String
p_value <- ParsecT String () Identity String
litStr ParsecT String () Identity String
-> ParsecT String () Identity String
-> ParsecT String () Identity String
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> ParsecT String () Identity String
p_token
(String, String) -> Parser (String, String)
forall a. a -> ParsecT String () Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return ((Char -> Char) -> ShowS
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 -> [(String, String)]
ctParameters :: [(String, String)]
}
deriving (Int -> ContentType -> ShowS
[ContentType] -> ShowS
ContentType -> String
(Int -> ContentType -> ShowS)
-> (ContentType -> String)
-> ([ContentType] -> ShowS)
-> Show ContentType
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ContentType -> ShowS
showsPrec :: Int -> ContentType -> ShowS
$cshow :: ContentType -> String
show :: ContentType -> String
$cshowList :: [ContentType] -> ShowS
showList :: [ContentType] -> ShowS
Show, ReadPrec [ContentType]
ReadPrec ContentType
Int -> ReadS ContentType
ReadS [ContentType]
(Int -> ReadS ContentType)
-> ReadS [ContentType]
-> ReadPrec ContentType
-> ReadPrec [ContentType]
-> Read ContentType
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS ContentType
readsPrec :: Int -> ReadS ContentType
$creadList :: ReadS [ContentType]
readList :: ReadS [ContentType]
$creadPrec :: ReadPrec ContentType
readPrec :: ReadPrec ContentType
$creadListPrec :: ReadPrec [ContentType]
readListPrec :: ReadPrec [ContentType]
Read)
instance Eq ContentType where
ContentType
x == :: ContentType -> ContentType -> Bool
== ContentType
y = ContentType -> String
ctType ContentType
x String -> String -> Bool
`caseInsensitiveEq` ContentType -> String
ctType ContentType
y
Bool -> Bool -> Bool
&& ContentType -> String
ctSubtype ContentType
x String -> String -> Bool
`caseInsensitiveEq` ContentType -> String
ctSubtype ContentType
y
Bool -> Bool -> Bool
&& ContentType -> [(String, String)]
ctParameters ContentType
x [(String, String)] -> [(String, String)] -> Bool
forall a. Eq a => a -> a -> Bool
== ContentType -> [(String, String)]
ctParameters ContentType
y
instance Ord ContentType where
ContentType
x compare :: ContentType -> ContentType -> Ordering
`compare` ContentType
y = [Ordering] -> Ordering
forall a. Monoid a => [a] -> a
M.mconcat [ContentType -> String
ctType ContentType
x String -> String -> Ordering
`caseInsensitiveCompare` ContentType -> String
ctType ContentType
y,
ContentType -> String
ctSubtype ContentType
x String -> String -> Ordering
`caseInsensitiveCompare` ContentType -> String
ctSubtype ContentType
y,
ContentType -> [(String, String)]
ctParameters ContentType
x [(String, String)] -> [(String, String)] -> Ordering
forall a. Ord a => a -> a -> Ordering
`compare` ContentType -> [(String, String)]
ctParameters ContentType
y]
instance HeaderValue ContentType where
parseHeaderValue :: Parser ContentType
parseHeaderValue =
do String
_ <- ParsecT String () Identity Char
-> ParsecT String () Identity String
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many ParsecT String () Identity Char
ws1
String
c_type <- ParsecT String () Identity String
p_token
Char
_ <- Char -> ParsecT String () Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'/'
String
c_subtype <- ParsecT String () Identity String
-> ParsecT String () Identity String
forall a. Parser a -> Parser a
lexeme (ParsecT String () Identity String
-> ParsecT String () Identity String)
-> ParsecT String () Identity String
-> ParsecT String () Identity String
forall a b. (a -> b) -> a -> b
$ ParsecT String () Identity String
p_token
[(String, String)]
c_parameters <- Parser (String, String)
-> ParsecT String () Identity [(String, String)]
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many Parser (String, String)
p_parameter
ContentType -> Parser ContentType
forall a. a -> ParsecT String () Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (ContentType -> Parser ContentType)
-> ContentType -> Parser ContentType
forall a b. (a -> b) -> a -> b
$ String -> String -> [(String, String)] -> ContentType
ContentType ((Char -> Char) -> ShowS
forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
toLower String
c_type) ((Char -> Char) -> ShowS
forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
toLower String
c_subtype) [(String, String)]
c_parameters
prettyHeaderValue :: ContentType -> String
prettyHeaderValue (ContentType String
x String
y [(String, String)]
ps) = String
x String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"/" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
y String -> ShowS
forall a. [a] -> [a] -> [a]
++ [(String, String)] -> String
showParameters [(String, String)]
ps
parseContentType :: MonadFail m => String -> m ContentType
parseContentType :: forall (m :: * -> *). MonadFail m => String -> m ContentType
parseContentType = Parser ContentType -> String -> String -> m ContentType
forall (m :: * -> *) a.
MonadFail m =>
Parser a -> String -> String -> m a
parseM Parser ContentType
forall a. HeaderValue a => Parser a
parseHeaderValue String
"Content-type"
showContentType :: ContentType -> String
showContentType :: ContentType -> String
showContentType = ContentType -> String
forall a. HeaderValue a => a -> String
prettyHeaderValue
getContentType :: MonadFail m => Headers -> m ContentType
getContentType :: forall (m :: * -> *). MonadFail m => Headers -> m ContentType
getContentType = String -> Headers -> m ContentType
forall (m :: * -> *) a.
(MonadFail m, HeaderValue a) =>
String -> Headers -> m a
getHeaderValue String
"content-type"
data ContentTransferEncoding =
ContentTransferEncoding String
deriving (Int -> ContentTransferEncoding -> ShowS
[ContentTransferEncoding] -> ShowS
ContentTransferEncoding -> String
(Int -> ContentTransferEncoding -> ShowS)
-> (ContentTransferEncoding -> String)
-> ([ContentTransferEncoding] -> ShowS)
-> Show ContentTransferEncoding
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ContentTransferEncoding -> ShowS
showsPrec :: Int -> ContentTransferEncoding -> ShowS
$cshow :: ContentTransferEncoding -> String
show :: ContentTransferEncoding -> String
$cshowList :: [ContentTransferEncoding] -> ShowS
showList :: [ContentTransferEncoding] -> ShowS
Show, ReadPrec [ContentTransferEncoding]
ReadPrec ContentTransferEncoding
Int -> ReadS ContentTransferEncoding
ReadS [ContentTransferEncoding]
(Int -> ReadS ContentTransferEncoding)
-> ReadS [ContentTransferEncoding]
-> ReadPrec ContentTransferEncoding
-> ReadPrec [ContentTransferEncoding]
-> Read ContentTransferEncoding
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS ContentTransferEncoding
readsPrec :: Int -> ReadS ContentTransferEncoding
$creadList :: ReadS [ContentTransferEncoding]
readList :: ReadS [ContentTransferEncoding]
$creadPrec :: ReadPrec ContentTransferEncoding
readPrec :: ReadPrec ContentTransferEncoding
$creadListPrec :: ReadPrec [ContentTransferEncoding]
readListPrec :: ReadPrec [ContentTransferEncoding]
Read, ContentTransferEncoding -> ContentTransferEncoding -> Bool
(ContentTransferEncoding -> ContentTransferEncoding -> Bool)
-> (ContentTransferEncoding -> ContentTransferEncoding -> Bool)
-> Eq ContentTransferEncoding
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ContentTransferEncoding -> ContentTransferEncoding -> Bool
== :: ContentTransferEncoding -> ContentTransferEncoding -> Bool
$c/= :: ContentTransferEncoding -> ContentTransferEncoding -> Bool
/= :: ContentTransferEncoding -> ContentTransferEncoding -> Bool
Eq, Eq ContentTransferEncoding
Eq ContentTransferEncoding =>
(ContentTransferEncoding -> ContentTransferEncoding -> Ordering)
-> (ContentTransferEncoding -> ContentTransferEncoding -> Bool)
-> (ContentTransferEncoding -> ContentTransferEncoding -> Bool)
-> (ContentTransferEncoding -> ContentTransferEncoding -> Bool)
-> (ContentTransferEncoding -> ContentTransferEncoding -> Bool)
-> (ContentTransferEncoding
-> ContentTransferEncoding -> ContentTransferEncoding)
-> (ContentTransferEncoding
-> ContentTransferEncoding -> ContentTransferEncoding)
-> Ord 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
$ccompare :: ContentTransferEncoding -> ContentTransferEncoding -> Ordering
compare :: ContentTransferEncoding -> ContentTransferEncoding -> Ordering
$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
>= :: ContentTransferEncoding -> ContentTransferEncoding -> Bool
$cmax :: ContentTransferEncoding
-> ContentTransferEncoding -> ContentTransferEncoding
max :: ContentTransferEncoding
-> ContentTransferEncoding -> ContentTransferEncoding
$cmin :: ContentTransferEncoding
-> ContentTransferEncoding -> ContentTransferEncoding
min :: ContentTransferEncoding
-> ContentTransferEncoding -> ContentTransferEncoding
Ord)
instance HeaderValue ContentTransferEncoding where
parseHeaderValue :: Parser ContentTransferEncoding
parseHeaderValue =
do String
_ <- ParsecT String () Identity Char
-> ParsecT String () Identity String
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many ParsecT String () Identity Char
ws1
String
c_cte <- ParsecT String () Identity String
p_token
ContentTransferEncoding -> Parser ContentTransferEncoding
forall a. a -> ParsecT String () Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (ContentTransferEncoding -> Parser ContentTransferEncoding)
-> ContentTransferEncoding -> Parser ContentTransferEncoding
forall a b. (a -> b) -> a -> b
$ String -> ContentTransferEncoding
ContentTransferEncoding ((Char -> Char) -> ShowS
forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
toLower String
c_cte)
prettyHeaderValue :: ContentTransferEncoding -> String
prettyHeaderValue (ContentTransferEncoding String
s) = String
s
getContentTransferEncoding :: MonadFail m => Headers -> m ContentTransferEncoding
getContentTransferEncoding :: forall (m :: * -> *).
MonadFail m =>
Headers -> m ContentTransferEncoding
getContentTransferEncoding = String -> Headers -> m ContentTransferEncoding
forall (m :: * -> *) a.
(MonadFail m, HeaderValue a) =>
String -> Headers -> m a
getHeaderValue String
"content-transfer-encoding"
data ContentDisposition =
ContentDisposition String [(String, String)]
deriving (Int -> ContentDisposition -> ShowS
[ContentDisposition] -> ShowS
ContentDisposition -> String
(Int -> ContentDisposition -> ShowS)
-> (ContentDisposition -> String)
-> ([ContentDisposition] -> ShowS)
-> Show ContentDisposition
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ContentDisposition -> ShowS
showsPrec :: Int -> ContentDisposition -> ShowS
$cshow :: ContentDisposition -> String
show :: ContentDisposition -> String
$cshowList :: [ContentDisposition] -> ShowS
showList :: [ContentDisposition] -> ShowS
Show, ReadPrec [ContentDisposition]
ReadPrec ContentDisposition
Int -> ReadS ContentDisposition
ReadS [ContentDisposition]
(Int -> ReadS ContentDisposition)
-> ReadS [ContentDisposition]
-> ReadPrec ContentDisposition
-> ReadPrec [ContentDisposition]
-> Read ContentDisposition
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS ContentDisposition
readsPrec :: Int -> ReadS ContentDisposition
$creadList :: ReadS [ContentDisposition]
readList :: ReadS [ContentDisposition]
$creadPrec :: ReadPrec ContentDisposition
readPrec :: ReadPrec ContentDisposition
$creadListPrec :: ReadPrec [ContentDisposition]
readListPrec :: ReadPrec [ContentDisposition]
Read, ContentDisposition -> ContentDisposition -> Bool
(ContentDisposition -> ContentDisposition -> Bool)
-> (ContentDisposition -> ContentDisposition -> Bool)
-> Eq ContentDisposition
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ContentDisposition -> ContentDisposition -> Bool
== :: ContentDisposition -> ContentDisposition -> Bool
$c/= :: ContentDisposition -> ContentDisposition -> Bool
/= :: ContentDisposition -> ContentDisposition -> Bool
Eq, Eq ContentDisposition
Eq ContentDisposition =>
(ContentDisposition -> ContentDisposition -> Ordering)
-> (ContentDisposition -> ContentDisposition -> Bool)
-> (ContentDisposition -> ContentDisposition -> Bool)
-> (ContentDisposition -> ContentDisposition -> Bool)
-> (ContentDisposition -> ContentDisposition -> Bool)
-> (ContentDisposition -> ContentDisposition -> ContentDisposition)
-> (ContentDisposition -> ContentDisposition -> ContentDisposition)
-> Ord 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
$ccompare :: ContentDisposition -> ContentDisposition -> Ordering
compare :: ContentDisposition -> ContentDisposition -> Ordering
$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
>= :: ContentDisposition -> ContentDisposition -> Bool
$cmax :: ContentDisposition -> ContentDisposition -> ContentDisposition
max :: ContentDisposition -> ContentDisposition -> ContentDisposition
$cmin :: ContentDisposition -> ContentDisposition -> ContentDisposition
min :: ContentDisposition -> ContentDisposition -> ContentDisposition
Ord)
instance HeaderValue ContentDisposition where
parseHeaderValue :: Parser ContentDisposition
parseHeaderValue =
do String
_ <- ParsecT String () Identity Char
-> ParsecT String () Identity String
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many ParsecT String () Identity Char
ws1
String
c_cd <- ParsecT String () Identity String
p_token
[(String, String)]
c_parameters <- Parser (String, String)
-> ParsecT String () Identity [(String, String)]
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many Parser (String, String)
p_parameter
ContentDisposition -> Parser ContentDisposition
forall a. a -> ParsecT String () Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (ContentDisposition -> Parser ContentDisposition)
-> ContentDisposition -> Parser ContentDisposition
forall a b. (a -> b) -> a -> b
$ String -> [(String, String)] -> ContentDisposition
ContentDisposition ((Char -> Char) -> ShowS
forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
toLower String
c_cd) [(String, String)]
c_parameters
prettyHeaderValue :: ContentDisposition -> String
prettyHeaderValue (ContentDisposition String
t [(String, String)]
hs) =
String
t String -> ShowS
forall a. [a] -> [a] -> [a]
++ [String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [String
"; " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
n String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"=" String -> ShowS
forall a. [a] -> [a] -> [a]
++ ShowS
quote String
v | (String
n,String
v) <- [(String, String)]
hs]
where quote :: ShowS
quote String
x = String
"\"" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
x String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"\""
getContentDisposition :: MonadFail m => Headers -> m ContentDisposition
getContentDisposition :: forall (m :: * -> *).
MonadFail m =>
Headers -> m ContentDisposition
getContentDisposition = String -> Headers -> m ContentDisposition
forall (m :: * -> *) a.
(MonadFail m, HeaderValue a) =>
String -> Headers -> m a
getHeaderValue String
"content-disposition"
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 Parser a -> String -> String -> Either ParseError a
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 -> String -> m a
forall a. String -> m a
forall (m :: * -> *) a. MonadFail m => String -> m a
MFail.fail (ParseError -> String
forall a. Show a => a -> String
show ParseError
e)
Right a
x -> a -> m a
forall a. a -> m a
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 = m b -> (b -> m b) -> Maybe b -> m b
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (String -> m b
forall a. String -> m a
forall (m :: * -> *) a. MonadFail m => String -> m a
MFail.fail (String
"No such field: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ a -> String
forall a. Show a => a -> String
show a
n)) b -> m b
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe b -> m b) -> ([(a, b)] -> Maybe b) -> [(a, b)] -> m b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> [(a, b)] -> Maybe b
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup a
n
caseInsensitiveEq :: String -> String -> Bool
caseInsensitiveEq :: String -> String -> Bool
caseInsensitiveEq String
x String
y = (Char -> Char) -> ShowS
forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
toLower String
x String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== (Char -> Char) -> ShowS
forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
toLower String
y
caseInsensitiveCompare :: String -> String -> Ordering
caseInsensitiveCompare :: String -> String -> Ordering
caseInsensitiveCompare String
x String
y = (Char -> Char) -> ShowS
forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
toLower String
x String -> String -> Ordering
forall a. Ord a => a -> a -> Ordering
`compare` (Char -> Char) -> ShowS
forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
toLower String
y
ws1 :: Parser Char
ws1 :: ParsecT String () Identity Char
ws1 = String -> ParsecT String () Identity Char
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; String
_ <- ParsecT String () Identity Char
-> ParsecT String () Identity String
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many ParsecT String () Identity Char
ws1; a -> Parser a
forall a. a -> ParsecT String () Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return a
x
crLf :: Parser String
crLf :: ParsecT String () Identity String
crLf = ParsecT String () Identity String
-> ParsecT String () Identity String
forall tok st a. GenParser tok st a -> GenParser tok st a
try (String -> ParsecT String () Identity String
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
string String
"\n\r" ParsecT String () Identity String
-> ParsecT String () Identity String
-> ParsecT String () Identity String
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> String -> ParsecT String () Identity String
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
string String
"\r\n") ParsecT String () Identity String
-> ParsecT String () Identity String
-> ParsecT String () Identity String
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> String -> ParsecT String () Identity String
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
string String
"\n" ParsecT String () Identity String
-> ParsecT String () Identity String
-> ParsecT String () Identity String
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> String -> ParsecT String () Identity String
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
string String
"\r"
lineString :: Parser String
lineString :: ParsecT String () Identity String
lineString = ParsecT String () Identity Char
-> ParsecT String () Identity String
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many (String -> ParsecT String () Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m Char
noneOf String
"\n\r")
literalString :: Parser String
literalString :: ParsecT String () Identity String
literalString = do Char
_ <- Char -> ParsecT String () Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'\"'
String
str <- ParsecT String () Identity Char
-> ParsecT String () Identity String
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many (String -> ParsecT String () Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m Char
noneOf String
"\"\\" ParsecT String () Identity Char
-> ParsecT String () Identity Char
-> ParsecT String () Identity Char
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> ParsecT String () Identity Char
quoted_pair)
Char
_ <- Char -> ParsecT String () Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'\"'
String -> ParsecT String () Identity String
forall a. a -> ParsecT String () Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return String
str
buggyLiteralString :: Parser String
buggyLiteralString :: ParsecT String () Identity String
buggyLiteralString =
do Char
_ <- Char -> ParsecT String () Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'\"'
String
str <- ParsecT String () Identity Char
-> ParsecT String () Identity ()
-> ParsecT String () Identity String
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 ParsecT String () Identity Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
anyChar (ParsecT String () Identity () -> ParsecT String () Identity ()
forall tok st a. GenParser tok st a -> GenParser tok st a
try ParsecT String () Identity ()
forall {u}. ParsecT String u Identity ()
lastQuote)
String -> ParsecT String () Identity String
forall a. a -> ParsecT String () Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return String
str
where lastQuote :: ParsecT String u Identity ()
lastQuote = do Char
_ <- Char -> ParsecT String u Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'\"'
ParsecT String u Identity Char -> ParsecT String u Identity ()
forall s (m :: * -> *) t a u.
(Stream s m t, Show a) =>
ParsecT s u m a -> ParsecT s u m ()
notFollowedBy (ParsecT String u Identity Char -> ParsecT String u Identity Char
forall tok st a. GenParser tok st a -> GenParser tok st a
try (ParsecT String u Identity Char -> ParsecT String u Identity String
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many (String -> ParsecT String u Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m Char
noneOf String
"\"") ParsecT String u Identity String
-> ParsecT String u Identity Char -> ParsecT String u Identity Char
forall a b.
ParsecT String u Identity a
-> ParsecT String u Identity b -> ParsecT String u Identity b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Char -> ParsecT String u Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'\"'))
headerNameChar :: Parser Char
= String -> ParsecT String () Identity 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{|}~" String -> ShowS
forall a. Eq a => [a] -> [a] -> [a]
\\ String
tspecials
p_token :: Parser String
p_token :: ParsecT String () Identity String
p_token = ParsecT String () Identity Char
-> ParsecT String () Identity String
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m [a]
many1 (String -> ParsecT String () Identity Char
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 = (Int -> Char) -> [Int] -> String
forall a b. (a -> b) -> [a] -> [b]
map Int -> Char
chr ([Int
1..Int
9] [Int] -> [Int] -> [Int]
forall a. [a] -> [a] -> [a]
++ [Int
11,Int
12] [Int] -> [Int] -> [Int]
forall a. [a] -> [a] -> [a]
++ [Int
14..Int
127])
p_text :: Parser Char
p_text :: ParsecT String () Identity Char
p_text = String -> ParsecT String () Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m Char
oneOf String
text_chars
quoted_pair :: Parser Char
quoted_pair :: ParsecT String () Identity Char
quoted_pair = do Char
_ <- Char -> ParsecT String () Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'\\'
ParsecT String () Identity Char
p_text