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
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/" forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf`)
isHtmlMimeType :: String -> Bool
isHtmlMimeType :: String -> Bool
isHtmlMimeType String
t = String
t forall a. Eq a => a -> a -> Bool
== String
text_html
isXmlMimeType :: String -> Bool
isXmlMimeType :: String -> Bool
isXmlMimeType String
t = ( String
t 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" forall a. Eq a => [a] -> [a] -> Bool
`isSuffixOf` String
t
)
defaultMimeTypeTable :: MimeTypeTable
defaultMimeTypeTable :: MimeTypeTable
defaultMimeTypeTable = 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 = forall a. a -> Maybe a -> a
fromMaybe String
"" forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {a}. Map String a -> Maybe a
lookupMime
where
lookupMime :: Map String a -> Maybe a
lookupMime Map String a
t = forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup String
e Map String a
t
forall (m :: * -> *) a. MonadPlus m => m a -> m a -> m a
`mplus`
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup (forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
toLower String
e) Map String a
t
forall (m :: * -> *) a. MonadPlus m => m a -> m a -> m a
`mplus`
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup (forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
toUpper String
e) Map String a
t
readMimeTypeTable :: FilePath -> IO MimeTypeTable
readMimeTypeTable :: String -> IO MimeTypeTable
readMimeTypeTable String
inp = do
ByteString
cb <- String -> IO ByteString
B.readFile String
inp
forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall k a. Ord k => [(k, a)] -> Map k a
M.fromList forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [(String, String)]
parseMimeTypeTable forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> String
C.unpack forall a b. (a -> b) -> a -> b
$ ByteString
cb
parseMimeTypeTable :: String -> [(String, String)]
parseMimeTypeTable :: String -> [(String, String)]
parseMimeTypeTable = forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map [String] -> [(String, String)]
buildPairs
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map String -> [String]
words
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String
"#" forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf`))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (Char -> Bool
isSpace))
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) = forall a b. (a -> b) -> [a] -> [b]
map (\ String
x -> (String
x, String
mt)) forall a b. (a -> b) -> a -> b
$ [String]
exts