    -- ------------------------------------------------------------

    {-
       Module     : Text.XML.HXT.Parser.ProtocolHandlerUtil
       Copyright  : Copyright (C) 2008 Uwe Schmidt
       License    : MIT

       Maintainer : Uwe Schmidt (uwe@fh-wedel.de)
       Stability  : stable
       Portability: portable

       Protocol handler utility functions

    -}

    -- ------------------------------------------------------------

    module Text.XML.HXT.Parser.ProtocolHandlerUtil
        ( parseContentType
        )

    where

    import Text.XML.HXT.DOM.XmlKeywords

    import Text.XML.HXT.DOM.Util    ( stringToUpper
                                    , stringTrim
                                    )

    import qualified Text.ParserCombinators.Parsec as P

    -- ------------------------------------------------------------

    -- |
    -- Try to extract charset spec from Content-Type header
    -- e.g. \"text\/html; charset=ISO-8859-1\"
    --
    -- Sometimes the server deliver the charset spec in quotes
    -- these are removed

    parseContentType        :: P.Parser [(String, String)]
    parseContentType :: Parser [(String, String)]
    parseContentType
        = Parser [(String, String)] -> Parser [(String, String)]
    forall tok st a. GenParser tok st a -> GenParser tok st a
    P.try ( do
                  [(String, String)]
    mimeType <- ( do
                                String
    mt <- ParsecT String () Identity Char
    -> ParsecT String () Identity String
    forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
    P.many (String -> ParsecT String () Identity Char
    forall s (m :: * -> *) u.
    Stream s m Char =>
    String -> ParsecT s u m Char
    P.noneOf ";")
                                String -> Parser [(String, String)]
    forall (m :: * -> *). Monad m => String -> m [(String, String)]
    rtMT String
    mt
                              )
                  [(String, String)]
    charset  <- ( do
                                Char
    _ <- Char -> ParsecT String () Identity Char
    forall s (m :: * -> *) u.
    Stream s m Char =>
    Char -> ParsecT s u m Char
    P.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]
    P.many  (String -> ParsecT String () Identity Char
    forall s (m :: * -> *) u.
    Stream s m Char =>
    String -> ParsecT s u m Char
    P.oneOf " \t'")
                                String
    _ <- String -> ParsecT String () Identity String
    forall s (m :: * -> *) u.
    Stream s m Char =>
    String -> ParsecT s u m String
    P.string "charset="
                                Char
    _ <- Char
    -> ParsecT String () Identity Char
    -> ParsecT String () Identity Char
    forall s (m :: * -> *) t a u.
    Stream s m t =>
    a -> ParsecT s u m a -> ParsecT s u m a
    P.option '"' (String -> ParsecT String () Identity Char
    forall s (m :: * -> *) u.
    Stream s m Char =>
    String -> ParsecT s u m Char
    P.oneOf "\"'")
                                String
    cs <- 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]
    P.many1 (String -> ParsecT String () Identity Char
    forall s (m :: * -> *) u.
    Stream s m Char =>
    String -> ParsecT s u m Char
    P.noneOf "\"'")
                                [(String, String)] -> Parser [(String, String)]
    forall (m :: * -> *) a. Monad m => a -> m a
    return [ (String
    transferEncoding, String -> String
    stringToUpper String
    cs) ]
                              )
                  [(String, String)] -> Parser [(String, String)]
    forall (m :: * -> *) a. Monad m => a -> m a
    return ([(String, String)]
    mimeType [(String, String)] -> [(String, String)] -> [(String, String)]
    forall a. [a] -> [a] -> [a]
    ++ [(String, String)]
    charset)
                )
          Parser [(String, String)]
    -> Parser [(String, String)] -> Parser [(String, String)]
    forall s u (m :: * -> *) a.
    ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
    P.<|>
          ( do
            String
    mt <- ParsecT String () Identity Char
    -> ParsecT String () Identity String
    forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
    P.many (String -> ParsecT String () Identity Char
    forall s (m :: * -> *) u.
    Stream s m Char =>
    String -> ParsecT s u m Char
    P.noneOf ";")
            String -> Parser [(String, String)]
    forall (m :: * -> *). Monad m => String -> m [(String, String)]
    rtMT String
    mt
          )
        where
        rtMT :: String -> m [(String, String)]
    rtMT mt :: String
    mt = [(String, String)] -> m [(String, String)]
    forall (m :: * -> *) a. Monad m => a -> m a
    return [ (String
    transferMimeType, String -> String
    stringTrim String
    mt) ]

    -- ------------------------------------------------------------