    -- #hide

    -----------------------------------------------------------------------------
    -- |
    -- Module      :  Network.CGI.RFC822Headers
    -- Copyright   :  (c) Peter Thiemann 2001,2002
    --                (c) Bjorn Bringert 2005-2006
    --                (c) Lemmih 2007
    -- License     :  BSD-style
    --
    -- Maintainer  :  lemmih@vo.com
    -- Stability   :  experimental
    -- Portability :  portable
    --
    -- Parsing of RFC822-style headers (name, value pairs)
    -- Partly based on code from WASHMail.
    --
    -----------------------------------------------------------------------------
    module Happstack.Server.Internal.RFC822Headers
        ( -- * Headers
          Header,
          pHeader,
          pHeaders,
          parseHeaders,

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

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

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

          -- * Utilities
          parseM
          ) where

    import Control.Monad
    import Control.Monad.Fail (MonadFail)
    import Data.Char
    import Data.List
    import Text.ParserCombinators.Parsec

    type Header = (String, String)

    pHeaders :: Parser [Header]
    pHeaders :: Parser [Header]
    pHeaders = ParsecT String () Identity Header -> Parser [Header]
    forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
    many ParsecT String () Identity Header
    pHeader

    parseHeaders :: MonadFail m => SourceName -> String -> m [Header]
    parseHeaders :: forall (m :: * -> *). MonadFail m => String -> String -> m [Header]
    parseHeaders = Parser [Header] -> String -> String -> m [Header]
    forall (m :: * -> *) a.
    MonadFail m =>
    Parser a -> String -> String -> m a
    parseM Parser [Header]
    pHeaders

    pHeader :: Parser Header
    pHeader :: ParsecT String () Identity Header
    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
           void $ char ':'
           void $ many ws1
           line <- lineString
           void crLf
           extraLines <- many extraFieldLine
           return (map toLower name, concat (line:extraLines))

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

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

    showParameters :: [(String,String)] -> String
    showParameters :: [Header] -> String
    showParameters = (Header -> String) -> [Header] -> String
    forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
    concatMap Header -> String
    forall {t :: * -> *}. Foldable t => (String, t Char) -> String
    f
        where f :: (String, t Char) -> String
    f (String
    n,t Char
    v) = String
    "; " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    n String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    "=\"" String -> String -> String
    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 -> String -> String
    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 -> String -> String
    forall a. a -> [a] -> [a]
    :[Char
    c]
                    | Bool
    otherwise = [Char
    c]

    p_parameter :: Parser (String,String)
    p_parameter :: ParsecT String () Identity Header
    p_parameter =
      do ParsecT String () Identity Char -> ParsecT String () Identity ()
    forall (f :: * -> *) a. Functor f => f a -> f ()
    void (ParsecT String () Identity Char -> ParsecT String () Identity ())
    -> ParsecT String () Identity Char -> ParsecT String () Identity ()
    forall a b. (a -> b) -> a -> b
    $ 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 <- 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
         void $ 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]
    -> ParsecT String () Identity String
    forall s (m :: * -> *) t u a.
    Stream s m t =>
    [ParsecT s u m a] -> ParsecT s u m a
    choice [ ParsecT String () Identity String
    -> ParsecT String () Identity String
    forall tok st a. GenParser tok st a -> GenParser tok st a
    try ((ParsecT String () Identity () -> ParsecT String () Identity ()
    forall s (m :: * -> *) t u a.
    Stream s m t =>
    ParsecT s u m a -> ParsecT s u m a
    lookAhead (ParsecT String () Identity () -> ParsecT String () Identity ())
    -> ParsecT String () Identity () -> ParsecT String () Identity ()
    forall a b. (a -> b) -> a -> b
    $ do
                                            ParsecT String () Identity Header -> ParsecT String () Identity ()
    forall (f :: * -> *) a. Functor f => f a -> f ()
    void (ParsecT String () Identity String
    literalString ParsecT String () Identity String
    -> ParsecT String () Identity Header
    -> ParsecT String () Identity Header
    forall a b.
    ParsecT String () Identity a
    -> ParsecT String () Identity b -> ParsecT String () Identity b
    forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
    >>
                                                  ParsecT String () Identity Header
    p_parameter))
                                         ParsecT String () Identity ()
    -> ParsecT String () Identity String
    -> ParsecT String () Identity String
    forall a b.
    ParsecT String () Identity a
    -> ParsecT String () Identity b -> ParsecT String () Identity b
    forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
    >> ParsecT String () Identity String
    literalString)
                                   , 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 -> [Header]
    ctParameters :: [(String, String)]
                        }
        deriving (Int -> ContentType -> String -> String
    [ContentType] -> String -> String
    ContentType -> String
    (Int -> ContentType -> String -> String)
    -> (ContentType -> String)
    -> ([ContentType] -> String -> String)
    -> Show ContentType
    forall a.
    (Int -> a -> String -> String)
    -> (a -> String) -> ([a] -> String -> String) -> Show a
    $cshowsPrec :: Int -> ContentType -> String -> String
    showsPrec :: Int -> ContentType -> String -> String
    $cshow :: ContentType -> String
    show :: ContentType -> String
    $cshowList :: [ContentType] -> String -> String
    showList :: [ContentType] -> String -> String
    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, ContentType -> ContentType -> Bool
    (ContentType -> ContentType -> Bool)
    -> (ContentType -> ContentType -> Bool) -> Eq ContentType
    forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
    $c== :: ContentType -> ContentType -> Bool
    == :: ContentType -> ContentType -> Bool
    $c/= :: ContentType -> ContentType -> Bool
    /= :: ContentType -> ContentType -> Bool
    Eq, Eq ContentType
    Eq ContentType =>
    (ContentType -> ContentType -> Ordering)
    -> (ContentType -> ContentType -> Bool)
    -> (ContentType -> ContentType -> Bool)
    -> (ContentType -> ContentType -> Bool)
    -> (ContentType -> ContentType -> Bool)
    -> (ContentType -> ContentType -> ContentType)
    -> (ContentType -> ContentType -> ContentType)
    -> Ord 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
    $ccompare :: ContentType -> ContentType -> Ordering
    compare :: ContentType -> ContentType -> Ordering
    $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
    >= :: ContentType -> ContentType -> Bool
    $cmax :: ContentType -> ContentType -> ContentType
    max :: ContentType -> ContentType -> ContentType
    $cmin :: ContentType -> ContentType -> ContentType
    min :: ContentType -> ContentType -> ContentType
    Ord)

    -- | Produce the standard string representation of a content-type,
    --   e.g. \"text\/html; charset=ISO-8859-1\".
    showContentType :: ContentType -> String
    showContentType :: ContentType -> String
    showContentType (ContentType String
    x String
    y [Header]
    ps) = String
    x String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    "/" String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    y String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ [Header] -> String
    showParameters [Header]
    ps

    pContentType :: Parser ContentType
    pContentType :: Parser ContentType
    pContentType =
      do ParsecT String () Identity String -> ParsecT String () Identity ()
    forall (f :: * -> *) a. Functor f => f a -> f ()
    void (ParsecT String () Identity String
     -> ParsecT String () Identity ())
    -> ParsecT String () Identity String
    -> ParsecT String () Identity ()
    forall a b. (a -> b) -> a -> b
    $ 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 <- ParsecT String () Identity String
    p_token
         void $ lexeme $ char '/'
         c_subtype <- lexeme $ p_token
         c_parameters <- many p_parameter
         return $ ContentType (map toLower c_type) (map toLower c_subtype) c_parameters

    -- | 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
    pContentType String
    "Content-type"

    getContentType :: MonadFail m => [Header] -> m ContentType
    getContentType :: forall (m :: * -> *). MonadFail m => [Header] -> m ContentType
    getContentType [Header]
    hs = String -> [Header] -> m String
    forall (m :: * -> *) a b.
    (MonadFail m, Eq a, Show a) =>
    a -> [(a, b)] -> m b
    lookupM String
    "content-type" [Header]
    hs m String -> (String -> m ContentType) -> m ContentType
    forall a b. m a -> (a -> m b) -> m b
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= String -> m ContentType
    forall (m :: * -> *). MonadFail m => String -> m ContentType
    parseContentType

    --
    -- * Content transfer encoding
    --

    data ContentTransferEncoding =
            ContentTransferEncoding String
        deriving (Int -> ContentTransferEncoding -> String -> String
    [ContentTransferEncoding] -> String -> String
    ContentTransferEncoding -> String
    (Int -> ContentTransferEncoding -> String -> String)
    -> (ContentTransferEncoding -> String)
    -> ([ContentTransferEncoding] -> String -> String)
    -> Show ContentTransferEncoding
    forall a.
    (Int -> a -> String -> String)
    -> (a -> String) -> ([a] -> String -> String) -> Show a
    $cshowsPrec :: Int -> ContentTransferEncoding -> String -> String
    showsPrec :: Int -> ContentTransferEncoding -> String -> String
    $cshow :: ContentTransferEncoding -> String
    show :: ContentTransferEncoding -> String
    $cshowList :: [ContentTransferEncoding] -> String -> String
    showList :: [ContentTransferEncoding] -> String -> String
    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)

    pContentTransferEncoding :: Parser ContentTransferEncoding
    pContentTransferEncoding :: Parser ContentTransferEncoding
    pContentTransferEncoding =
      do ParsecT String () Identity String -> ParsecT String () Identity ()
    forall (f :: * -> *) a. Functor f => f a -> f ()
    void (ParsecT String () Identity String
     -> ParsecT String () Identity ())
    -> ParsecT String () Identity String
    -> ParsecT String () Identity ()
    forall a b. (a -> b) -> a -> b
    $ 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 <- ParsecT String () Identity String
    p_token
         return $ ContentTransferEncoding (map toLower c_cte)

    parseContentTransferEncoding :: MonadFail m => String -> m ContentTransferEncoding
    parseContentTransferEncoding :: forall (m :: * -> *).
    MonadFail m =>
    String -> m ContentTransferEncoding
    parseContentTransferEncoding =
        Parser ContentTransferEncoding
    -> String -> String -> m ContentTransferEncoding
    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 =
        String -> [Header] -> m String
    forall (m :: * -> *) a b.
    (MonadFail m, Eq a, Show a) =>
    a -> [(a, b)] -> m b
    lookupM String
    "content-transfer-encoding" [Header]
    hs m String
    -> (String -> m ContentTransferEncoding)
    -> m ContentTransferEncoding
    forall a b. m a -> (a -> m b) -> m b
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= String -> m ContentTransferEncoding
    forall (m :: * -> *).
    MonadFail m =>
    String -> m ContentTransferEncoding
    parseContentTransferEncoding

    --
    -- * Content disposition
    --

    data ContentDisposition =
            ContentDisposition String [(String, String)]
        deriving (Int -> ContentDisposition -> String -> String
    [ContentDisposition] -> String -> String
    ContentDisposition -> String
    (Int -> ContentDisposition -> String -> String)
    -> (ContentDisposition -> String)
    -> ([ContentDisposition] -> String -> String)
    -> Show ContentDisposition
    forall a.
    (Int -> a -> String -> String)
    -> (a -> String) -> ([a] -> String -> String) -> Show a
    $cshowsPrec :: Int -> ContentDisposition -> String -> String
    showsPrec :: Int -> ContentDisposition -> String -> String
    $cshow :: ContentDisposition -> String
    show :: ContentDisposition -> String
    $cshowList :: [ContentDisposition] -> String -> String
    showList :: [ContentDisposition] -> String -> String
    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)

    pContentDisposition :: Parser ContentDisposition
    pContentDisposition :: Parser ContentDisposition
    pContentDisposition =
      do ParsecT String () Identity String -> ParsecT String () Identity ()
    forall (f :: * -> *) a. Functor f => f a -> f ()
    void (ParsecT String () Identity String
     -> ParsecT String () Identity ())
    -> ParsecT String () Identity String
    -> ParsecT String () Identity ()
    forall a b. (a -> b) -> a -> b
    $ 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 <- ParsecT String () Identity String
    p_token
         c_parameters <- many p_parameter
         return $ ContentDisposition (map toLower c_cd) c_parameters

    parseContentDisposition :: MonadFail m => String -> m ContentDisposition
    parseContentDisposition :: forall (m :: * -> *). MonadFail m => String -> m ContentDisposition
    parseContentDisposition = Parser ContentDisposition
    -> String -> String -> m ContentDisposition
    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 =
        String -> [Header] -> m String
    forall (m :: * -> *) a b.
    (MonadFail m, Eq a, Show a) =>
    a -> [(a, b)] -> m b
    lookupM String
    "content-disposition" [Header]
    hs  m String
    -> (String -> m ContentDisposition) -> m ContentDisposition
    forall a b. m a -> (a -> m b) -> m b
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= String -> m ContentDisposition
    forall (m :: * -> *). MonadFail m => String -> m ContentDisposition
    parseContentDisposition

    --
    -- * 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
    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
    fail (String
    "No such field: " String -> String -> String
    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

    --
    -- * 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; void $ 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 ParsecT String () Identity Char -> ParsecT String () Identity ()
    forall (f :: * -> *) a. Functor f => f a -> f ()
    void (ParsecT String () Identity Char -> ParsecT String () Identity ())
    -> ParsecT String () Identity Char -> ParsecT String () Identity ()
    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
    '\"'
                       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)
                       void $ 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 ParsecT String () Identity Char -> ParsecT String () Identity ()
    forall (f :: * -> *) a. Functor f => f a -> f ()
    void (ParsecT String () Identity Char -> ParsecT String () Identity ())
    -> ParsecT String () Identity Char -> ParsecT String () Identity ()
    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
    '\"'
           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)
           return str
      where lastQuote :: ParsecT String u Identity ()
    lastQuote = do ParsecT String u Identity Char -> ParsecT String u Identity ()
    forall (f :: * -> *) a. Functor f => f a -> f ()
    void (ParsecT String u Identity Char -> ParsecT String u Identity ())
    -> ParsecT String u Identity Char -> ParsecT String u Identity ()
    forall a b. (a -> b) -> a -> b
    $ 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
    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
    "()<>@,;:\\\"/[]?="  -- RFC2045
    tokenchar :: String
    tokenchar = String
    "!\"#$%&'()*+,-./0123456789:;<=>?@ABCDEFGHIJKLMNOPQRSTUVWXYZ[\\]^_`abcdefghijklmnopqrstuvwxyz{|}~" String -> String -> String
    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 ParsecT String () Identity Char -> ParsecT String () Identity ()
    forall (f :: * -> *) a. Functor f => f a -> f ()
    void (ParsecT String () Identity Char -> ParsecT String () Identity ())
    -> ParsecT String () Identity Char -> ParsecT String () Identity ()
    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
    '\\'
                     ParsecT String () Identity Char
    p_text