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

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

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