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

{-
   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
";")
                            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 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 String
" \t'")
                            String
_ <- String -> ParsecT String () Identity String
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
P.string 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 Char
'"' (String -> ParsecT String () Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m Char
P.oneOf String
"\"'")
                            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, 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
";")
        String -> Parser [(String, String)]
forall (m :: * -> *). Monad m => String -> m [(String, String)]
rtMT String
mt
      )
    where
    rtMT :: String -> m [(String, String)]
rtMT String
mt = [(String, String)] -> m [(String, String)]
forall (m :: * -> *) a. Monad m => a -> m a
return [ (String
transferMimeType, String -> String
stringTrim String
mt) ]

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