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

    {- |
       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_xdtd,
     text_xml,
     text_xml_external_parsed_entity        :: String

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

    text_html :: String
    text_html                               = String
    "text/html"
    text_pdf :: String
    text_pdf                                = String
    "text/pdf"
    text_plain :: String
    text_plain                              = String
    "text/plain"
    text_xdtd :: String
    text_xdtd                               = String
    "text/x-dtd"
    text_xml :: String
    text_xml                                = String
    "text/xml"
    text_xml_external_parsed_entity :: String
    text_xml_external_parsed_entity         = String
    "text/xml-external-parsed-entity"

    isTextMimeType                          :: String -> Bool
    isTextMimeType :: String -> Bool
    isTextMimeType                          = (String
    "text/" String -> String -> Bool
    forall a. Eq a => [a] -> [a] -> Bool
    `isPrefixOf`)

    isHtmlMimeType                          :: String -> Bool
    isHtmlMimeType :: String -> Bool
    isHtmlMimeType String
    t                        = String
    t String -> String -> Bool
    forall a. Eq a => a -> a -> Bool
    == String
    text_html

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

    defaultMimeTypeTable                    :: MimeTypeTable
    defaultMimeTypeTable :: MimeTypeTable
    defaultMimeTypeTable                    = [(String, String)] -> MimeTypeTable
    forall k a. Ord k => [(k, a)] -> Map k a
    M.fromList [(String, String)]
    mimeTypeDefaults

    extensionToMimeType                     :: String -> MimeTypeTable -> String
    extensionToMimeType :: String -> MimeTypeTable -> String
    extensionToMimeType String
    e                   = String -> Maybe String -> String
    forall a. a -> Maybe a -> a
    fromMaybe String
    "" (Maybe String -> String)
    -> (MimeTypeTable -> Maybe String) -> MimeTypeTable -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . MimeTypeTable -> Maybe String
    forall {a}. Map String a -> Maybe a
    lookupMime
        where
        lookupMime :: Map String a -> Maybe a
    lookupMime Map String a
    t                        = String -> Map String a -> Maybe a
    forall k a. Ord k => k -> Map k a -> Maybe a
    M.lookup String
    e Map String a
    t                  -- try exact match
                                              Maybe a -> Maybe a -> Maybe a
    forall a. Maybe a -> Maybe a -> Maybe a
    forall (m :: * -> *) a. MonadPlus m => m a -> m a -> m a
    `mplus`
                                              String -> Map String a -> Maybe a
    forall k a. Ord k => k -> Map k a -> Maybe a
    M.lookup ((Char -> Char) -> String -> String
    forall a b. (a -> b) -> [a] -> [b]
    map Char -> Char
    toLower String
    e) Map String a
    t    -- else try lowercase match
                                              Maybe a -> Maybe a -> Maybe a
    forall a. Maybe a -> Maybe a -> Maybe a
    forall (m :: * -> *) a. MonadPlus m => m a -> m a -> m a
    `mplus`
                                              String -> Map String a -> Maybe a
    forall k a. Ord k => k -> Map k a -> Maybe a
    M.lookup ((Char -> Char) -> String -> String
    forall a b. (a -> b) -> [a] -> [b]
    map Char -> Char
    toUpper String
    e) Map String a
    t    -- else try uppercase match

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

    readMimeTypeTable                       :: FilePath -> IO MimeTypeTable
    readMimeTypeTable :: String -> IO MimeTypeTable
    readMimeTypeTable String
    inp                   = do
                                              ByteString
    cb <- String -> IO ByteString
    B.readFile String
    inp
                                              MimeTypeTable -> IO MimeTypeTable
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (MimeTypeTable -> IO MimeTypeTable)
    -> (ByteString -> MimeTypeTable) -> ByteString -> IO MimeTypeTable
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . [(String, String)] -> MimeTypeTable
    forall k a. Ord k => [(k, a)] -> Map k a
    M.fromList ([(String, String)] -> MimeTypeTable)
    -> (ByteString -> [(String, String)])
    -> ByteString
    -> MimeTypeTable
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> [(String, String)]
    parseMimeTypeTable (String -> [(String, String)])
    -> (ByteString -> String) -> ByteString -> [(String, String)]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ByteString -> String
    C.unpack (ByteString -> IO MimeTypeTable) -> ByteString -> IO MimeTypeTable
    forall a b. (a -> b) -> a -> b
    $ ByteString
    cb

    parseMimeTypeTable                      :: String -> [(String, String)]
    parseMimeTypeTable :: String -> [(String, String)]
    parseMimeTypeTable                      = [[(String, String)]] -> [(String, String)]
    forall (t :: * -> *) a. Foldable t => t [a] -> [a]
    concat
                                              ([[(String, String)]] -> [(String, String)])
    -> (String -> [[(String, String)]]) -> String -> [(String, String)]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ([String] -> [(String, String)])
    -> [[String]] -> [[(String, String)]]
    forall a b. (a -> b) -> [a] -> [b]
    map [String] -> [(String, String)]
    buildPairs
                                              ([[String]] -> [[(String, String)]])
    -> (String -> [[String]]) -> String -> [[(String, String)]]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (String -> [String]) -> [String] -> [[String]]
    forall a b. (a -> b) -> [a] -> [b]
    map String -> [String]
    words
                                              ([String] -> [[String]])
    -> (String -> [String]) -> String -> [[String]]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (String -> Bool) -> [String] -> [String]
    forall a. (a -> Bool) -> [a] -> [a]
    filter (Bool -> Bool
    not (Bool -> Bool) -> (String -> Bool) -> String -> Bool
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (String
    "#" String -> String -> Bool
    forall a. Eq a => [a] -> [a] -> Bool
    `isPrefixOf`))
                                              ([String] -> [String])
    -> (String -> [String]) -> String -> [String]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (String -> Bool) -> [String] -> [String]
    forall a. (a -> Bool) -> [a] -> [a]
    filter (Bool -> Bool
    not (Bool -> Bool) -> (String -> Bool) -> String -> Bool
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (Char -> Bool) -> String -> Bool
    forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
    all (Char -> Bool
    isSpace))
                                              ([String] -> [String])
    -> (String -> [String]) -> String -> [String]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> [String]
    lines
        where
        buildPairs                          :: [String] -> [(String, String)]
        buildPairs :: [String] -> [(String, String)]
    buildPairs  []                      = []
        buildPairs  (String
    mt:[String]
    exts)               = (String -> (String, String)) -> [String] -> [(String, String)]
    forall a b. (a -> b) -> [a] -> [b]
    map (\ String
    x -> (String
    x, String
    mt)) ([String] -> [(String, String)]) -> [String] -> [(String, String)]
    forall a b. (a -> b) -> a -> b
    $ [String]
    exts

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