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

    {- |
       Module     : Text.XML.HXT.DOM.MimeTypes
       Copyright  : Copyright (C) 2008 Uwe Schmidt
       License    : MIT

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

       mime type related data and functions

    -}

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

    module Text.XML.HXT.DOM.MimeTypes
    where

    import           Control.Monad		( mplus )

    import qualified Data.ByteString	as B
    import qualified Data.ByteString.Char8  as C

    import           Data.Char
    import           Data.List
    import qualified Data.Map		as M
    import           Data.Maybe

    import           Text.XML.HXT.DOM.MimeTypeDefaults

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

    type MimeTypeTable	= M.Map String String

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

    -- mime types
    --
    -- see RFC \"http:\/\/www.rfc-editor.org\/rfc\/rfc3023.txt\"

    application_xhtml,
     application_xml,
     application_xml_external_parsed_entity,
     application_xml_dtd,
     text_html,
     text_pdf,
     text_plain,
     text_xml,
     text_xml_external_parsed_entity	:: String

    application_xhtml			= "application/xhtml+xml"
    application_xml				= "application/xml"
    application_xml_external_parsed_entity	= "application/xml-external-parsed-entity"
    application_xml_dtd			= "application/xml-dtd"

    text_html				= "text/html"
    text_pdf				= "text/pdf"
    text_plain				= "text/plain"
    text_xml				= "text/xml"
    text_xml_external_parsed_entity		= "text/xml-external-parsed-entity"

    isTextMimeType				:: String -> Bool
    isTextMimeType				= ("text/" `isPrefixOf`)

    isHtmlMimeType				:: String -> Bool
    isHtmlMimeType t			= t == text_html

    isXmlMimeType				:: String -> Bool
    isXmlMimeType t				= ( t `elem` [ application_xhtml
    						     , application_xml
    						     , application_xml_external_parsed_entity
    						     , application_xml_dtd
    						     , text_xml
    						     , text_xml_external_parsed_entity
    						     ]
    					    ||
    					    "+xml" `isSuffixOf` t		-- application/mathml+xml
    					  )					-- or image/svg+xml

    defaultMimeTypeTable			:: MimeTypeTable
    defaultMimeTypeTable			= M.fromList mimeTypeDefaults

    extensionToMimeType			:: String -> MimeTypeTable -> String
    extensionToMimeType e			= fromMaybe "" . lookupMime
        where
        lookupMime t			= M.lookup e t			-- try exact match
    					  `mplus`
    					  M.lookup (map toLower e) t	-- else try lowercase match
    					  `mplus`
    					  M.lookup (map toUpper e) t	-- else try uppercase match

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

    readMimeTypeTable			:: FilePath -> IO MimeTypeTable
    readMimeTypeTable inp			= do
    					  cb <- B.readFile inp
    					  return . M.fromList . parseMimeTypeTable . C.unpack $ cb

    parseMimeTypeTable			:: String -> [(String, String)]
    parseMimeTypeTable			= concat
    					  . map buildPairs
    					  . map words
    					  . filter (not . ("#" `isPrefixOf`))
    					  . filter (not . all (isSpace))
    					  . lines
        where
        buildPairs				:: [String] -> [(String, String)]
        buildPairs	[] 			= []
        buildPairs	(mt:exts) 		= map (\ x -> (x, mt)) $ exts

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