    -- #hide

    -----------------------------------------------------------------------------
    -- |
    -- Module      :  Network.CGI.Header
    -- Copyright   :  (c) Peter Thiemann 2001,2002
    --                (c) Bjorn Bringert 2005-2006
    -- License     :  BSD-style
    --
    -- Maintainer  :  Anders Kaseorg <andersk@mit.edu>
    -- Stability   :  experimental
    -- Portability :  non-portable
    --
    -- Parsing of HTTP headers (name, value pairs)
    -- Partly based on code from WASHMail.
    --
    -----------------------------------------------------------------------------
    module Network.Multipart.Header (
                                  -- * Headers
                                  Headers,
                                  HeaderName(..),
                                  HeaderValue(..),
                                  pHeaders,

                                  -- * Content-type
                                  ContentType(..),
                                  getContentType,
                                  parseContentType,
                                  showContentType,

                                  -- * Content-transfer-encoding
                                  ContentTransferEncoding(..),
                                  getContentTransferEncoding,

                                  -- * Content-disposition
                                  ContentDisposition(..),
                                  getContentDisposition,

                                  -- * Utilities
                                  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

    --
    -- * Headers
    --

    -- | HTTP headers.
    type Headers = [(HeaderName, String)]

    -- | A string with case insensitive equality and comparisons.
    newtype HeaderName = HeaderName 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 HeaderValue a where
        parseHeaderValue :: Parser a
        prettyHeaderValue :: a -> String

    pHeaders :: Parser Headers
    pHeaders :: Parser Headers
    pHeaders = 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)
    pHeader :: ParsecT String () Identity (HeaderName, String)
    pHeader =
        do name <- ParsecT String () Identity Char
    -> ParsecT String () Identity String
    forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
    many1 ParsecT String () Identity Char
    headerNameChar
           _ <- char ':'
           _ <- many ws1
           line <- lineString
           _ <- crLf
           extraLines <- many extraFieldLine
           return (HeaderName name, concat (line:extraLines))

    extraFieldLine :: Parser String
    extraFieldLine :: ParsecT String () Identity String
    extraFieldLine =
        do sp <- ParsecT String () Identity Char
    ws1
           line <- lineString
           _ <- crLf
           return (sp:line)

    getHeaderValue :: (MonadFail m, HeaderValue a) => String -> Headers -> m a
    getHeaderValue :: forall (m :: * -> *) a.
    (MonadFail m, HeaderValue a) =>
    String -> Headers -> m a
    getHeaderValue 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

    --
    -- * Parameters (for Content-type etc.)
    --

    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 _ <- 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
    ';'
         p_name <- lexeme $ p_token
         -- Don't allow parameters named q. This is needed for parsing Accept-X
         -- headers. From RFC 2616 14.1:
         --    Note: Use of the "q" parameter name to separate media type
         --    parameters from Accept extension parameters is due to historical
         --    practice. Although this prevents any media type parameter named
         --    "q" from being used with a media range, such an event is believed
         --    to be unlikely given the lack of any "q" parameters in the IANA
         --    media type registry and the rare usage of any media type
         --    parameters in Accept. Future media types are discouraged from
         --    registering any parameter named "q".
         when (p_name == "q") pzero
         _ <- lexeme $ char '='
         -- Workaround for seemingly standardized web browser bug
         -- where nothing is escaped in the filename parameter
         -- of the content-disposition header in multipart/form-data
         let 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
         p_value <- litStr <|> p_token
         return (map toLower p_name, p_value)

    --
    -- * Content type
    --

    -- | A MIME media type value.
    --   The 'Show' instance is derived automatically.
    --   Use 'showContentType' to obtain the standard
    --   string representation.
    --   See <http://www.ietf.org/rfc/rfc2046.txt> for more
    --   information about MIME media types.
    data ContentType =
        ContentType {
                         -- | The top-level media type, the general type
                         --   of the data. Common examples are
                         --   \"text\", \"image\", \"audio\", \"video\",
                         --   \"multipart\", and \"application\".
                         ContentType -> String
    ctType :: String,
                         -- | The media subtype, the specific data format.
                         --   Examples include \"plain\", \"html\",
                         --   \"jpeg\", \"form-data\", etc.
                         ContentType -> String
    ctSubtype :: String,
                         -- | Media type parameters. On common example is
                         --   the charset parameter for the \"text\"
                         --   top-level type, e.g. @(\"charset\",\"ISO-8859-1\")@.
                         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 _ <- 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
               c_type <- p_token
               _ <- char '/'
               c_subtype <- lexeme $ p_token
               c_parameters <- many p_parameter
               return $ ContentType (map toLower c_type) (map toLower c_subtype) 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

    -- | Parse the standard representation of a content-type.
    --   If the input cannot be parsed, this function calls
    --   'fail' with a (hopefully) informative error message.
    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"

    --
    -- * Content transfer encoding
    --

    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 _ <- 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
               c_cte <- p_token
               return $ ContentTransferEncoding (map toLower 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"

    --
    -- * Content disposition
    --

    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 _ <- 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
               c_cd <- p_token
               c_parameters <- many p_parameter
               return $ ContentDisposition (map toLower c_cd) 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
    "\"" -- NOTE: silly, but de-facto standard

    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"

    --
    -- * Utilities
    --

    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

    --
    -- * Parsing utilities
    --

    -- | RFC 822 LWSP-char
    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 x <- Parser a
    p; _ <- many ws1; return x

    -- | RFC 822 CRLF (but more permissive)
    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"

    -- | One line
    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 -> ParsecT String () Identity Char
    forall s (m :: * -> *) u.
    Stream s m Char =>
    Char -> ParsecT s u m Char
    char Char
    '\"'
                       str <- many (noneOf "\"\\" <|> quoted_pair)
                       _ <- char '\"'
                       return str

    -- No web browsers seem to implement RFC 2046 correctly,
    -- since they do not escape double quotes and backslashes
    -- in the filename parameter in multipart/form-data.
    --
    -- Note that this eats everything until the last double quote on the line.
    buggyLiteralString :: Parser String
    buggyLiteralString :: ParsecT String () Identity String
    buggyLiteralString =
        do _ <- Char -> ParsecT String () Identity Char
    forall s (m :: * -> *) u.
    Stream s m Char =>
    Char -> ParsecT s u m Char
    char Char
    '\"'
           str <- manyTill anyChar (try lastQuote)
           return str
      where lastQuote :: ParsecT String u Identity ()
    lastQuote = do _ <- Char -> ParsecT String u Identity Char
    forall s (m :: * -> *) u.
    Stream s m Char =>
    Char -> ParsecT s u m Char
    char Char
    '\"'
                           notFollowedBy (try (many (noneOf "\"") >> char '\"'))

    headerNameChar :: Parser Char
    headerNameChar :: ParsecT String () Identity Char
    headerNameChar = 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 u (m :: * -> *) a. 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 -> ParsecT String () Identity Char
    forall s (m :: * -> *) u.
    Stream s m Char =>
    Char -> ParsecT s u m Char
    char Char
    '\\'
                     p_text