module Data.MIME.Types (
defaultmtd,
readMIMETypes,
hReadMIMETypes,
readSystemMIMETypes,
MIMEResults,
MIMETypeData(..),
guessType,
guessExtension,
guessAllExtensions
)
where
import qualified Data.Map as Map
import qualified Control.Exception (try, IOException)
import Control.Monad ( foldM )
import System.IO
( Handle, hClose, openFile, IOMode(ReadMode) )
import System.IO.Error ()
import System.IO.Utils ( hGetLines )
import System.Path ( splitExt )
import Data.Map.Utils ( flippedLookupM )
import Data.Char ( toLower )
data MIMETypeData = MIMETypeData
{
MIMETypeData -> Map String String
suffixMap :: Map.Map String String,
MIMETypeData -> Map String String
encodingsMap :: Map.Map String String,
MIMETypeData -> Map String String
typesMap :: Map.Map String String,
MIMETypeData -> Map String String
commonTypesMap :: Map.Map String String
}
type MIMEResults = (Maybe String,
Maybe String
)
readMIMETypes :: MIMETypeData
-> Bool
-> FilePath
-> IO MIMETypeData
readMIMETypes :: MIMETypeData -> Bool -> String -> IO MIMETypeData
readMIMETypes MIMETypeData
mtd Bool
strict String
fn = do
Handle
h <- String -> IOMode -> IO Handle
openFile String
fn IOMode
ReadMode
MIMETypeData -> Bool -> Handle -> IO MIMETypeData
hReadMIMETypes MIMETypeData
mtd Bool
strict Handle
h
hReadMIMETypes :: MIMETypeData
-> Bool
-> Handle
-> IO MIMETypeData
hReadMIMETypes :: MIMETypeData -> Bool -> Handle -> IO MIMETypeData
hReadMIMETypes MIMETypeData
mtd Bool
strict Handle
h = (MIMETypeData -> String -> MIMETypeData)
-> MIMETypeData -> [String] -> MIMETypeData
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl MIMETypeData -> String -> MIMETypeData
parseline MIMETypeData
mtd ([String] -> MIMETypeData) -> IO [String] -> IO MIMETypeData
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Handle -> IO [String]
forall a. HVIO a => a -> IO [String]
hGetLines Handle
h
where
parseline :: MIMETypeData -> String -> MIMETypeData
parseline :: MIMETypeData -> String -> MIMETypeData
parseline MIMETypeData
obj String
line =
let l1 :: [String]
l1 = String -> [String]
words String
line
procwords :: [String] -> [String]
procwords [] = []
procwords ((Char
'#':String
_) :[String]
_) = []
procwords (String
x:[String]
xs) = String
x String -> [String] -> [String]
forall a. a -> [a] -> [a]
: [String] -> [String]
procwords [String]
xs
l2 :: [String]
l2 = [String] -> [String]
procwords [String]
l1
in
if ([String] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [String]
l2) Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
2 then
let thetype :: String
thetype = [String] -> String
forall a. [a] -> a
head [String]
l2
suffixlist :: [String]
suffixlist = [String] -> [String]
forall a. [a] -> [a]
tail [String]
l2
in
(MIMETypeData -> String -> MIMETypeData)
-> MIMETypeData -> [String] -> MIMETypeData
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl (\MIMETypeData
o String
suff -> MIMETypeData -> Bool -> String -> String -> MIMETypeData
addType MIMETypeData
o Bool
strict String
thetype (Char
'.' Char -> String -> String
forall a. a -> [a] -> [a]
: String
suff)) MIMETypeData
obj [String]
suffixlist
else MIMETypeData
obj
guessType :: MIMETypeData
-> Bool
-> String
-> MIMEResults
guessType :: MIMETypeData -> Bool -> String -> MIMEResults
guessType MIMETypeData
mtd Bool
strict String
fn =
let mapext :: (String, String) -> (String, String)
mapext (String
base, String
ex) =
case String -> Map String String -> Maybe String
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup String
ex (MIMETypeData -> Map String String
suffixMap MIMETypeData
mtd) of
Maybe String
Nothing -> (String
base, String
ex)
Just String
x -> (String, String) -> (String, String)
mapext (String -> (String, String)
splitExt (String
base String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
x))
checkencodings :: (String, String) -> (String, String, Maybe String)
checkencodings (String
base, String
ex) =
case String -> Map String String -> Maybe String
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup String
ex (MIMETypeData -> Map String String
encodingsMap MIMETypeData
mtd) of
Maybe String
Nothing -> (String
base, String
ex, Maybe String
forall a. Maybe a
Nothing)
Just String
x -> ((String, String) -> String
forall a b. (a, b) -> a
fst (String -> (String, String)
splitExt String
base),
(String, String) -> String
forall a b. (a, b) -> b
snd (String -> (String, String)
splitExt String
base),
String -> Maybe String
forall a. a -> Maybe a
Just String
x)
(String
_, String
ext, Maybe String
enc) = (String, String) -> (String, String, Maybe String)
checkencodings ((String, String) -> (String, String, Maybe String))
-> ((String, String) -> (String, String))
-> (String, String)
-> (String, String, Maybe String)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String, String) -> (String, String)
mapext ((String, String) -> (String, String, Maybe String))
-> (String, String) -> (String, String, Maybe String)
forall a b. (a -> b) -> a -> b
$ String -> (String, String)
splitExt String
fn
typemap :: Map String String
typemap = MIMETypeData -> Bool -> Map String String
getStrict MIMETypeData
mtd Bool
strict
in
case String -> Map String String -> Maybe String
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup String
ext Map String String
typemap of
Maybe String
Nothing -> (String -> Map String String -> Maybe String
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup ((Char -> Char) -> String -> String
forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
toLower String
ext) Map String String
typemap, Maybe String
enc)
Just String
x -> (String -> Maybe String
forall a. a -> Maybe a
Just String
x, Maybe String
enc)
guessExtension :: MIMETypeData
-> Bool
-> String
-> Maybe String
guessExtension :: MIMETypeData -> Bool -> String -> Maybe String
guessExtension MIMETypeData
mtd Bool
strict String
fn =
case MIMETypeData -> Bool -> String -> [String]
guessAllExtensions MIMETypeData
mtd Bool
strict String
fn of
[] -> Maybe String
forall a. Maybe a
Nothing
(String
x:[String]
_) -> String -> Maybe String
forall a. a -> Maybe a
Just String
x
guessAllExtensions :: MIMETypeData
-> Bool
-> String
-> [String]
guessAllExtensions :: MIMETypeData -> Bool -> String -> [String]
guessAllExtensions MIMETypeData
mtd Bool
strict String
fn =
let mimetype :: String
mimetype = (Char -> Char) -> String -> String
forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
toLower String
fn
themap :: Map String String
themap = MIMETypeData -> Bool -> Map String String
getStrict MIMETypeData
mtd Bool
strict
in
String -> Map String String -> [String]
forall val key. (Ord val, Ord key) => val -> Map key val -> [key]
flippedLookupM String
mimetype Map String String
themap
addType :: MIMETypeData
-> Bool
-> String
-> String
-> MIMETypeData
addType :: MIMETypeData -> Bool -> String -> String -> MIMETypeData
addType MIMETypeData
mtd Bool
strict String
thetype String
theext =
MIMETypeData
-> Bool -> (Map String String -> Map String String) -> MIMETypeData
setStrict MIMETypeData
mtd Bool
strict (\Map String String
m -> String -> String -> Map String String -> Map String String
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert String
theext String
thetype Map String String
m)
defaultmtd :: MIMETypeData
defaultmtd :: MIMETypeData
defaultmtd =
MIMETypeData :: Map String String
-> Map String String
-> Map String String
-> Map String String
-> MIMETypeData
MIMETypeData {suffixMap :: Map String String
suffixMap = Map String String
default_suffix_map,
encodingsMap :: Map String String
encodingsMap = Map String String
default_encodings_map,
typesMap :: Map String String
typesMap = Map String String
default_types_map,
commonTypesMap :: Map String String
commonTypesMap = Map String String
default_common_types}
readSystemMIMETypes :: MIMETypeData -> IO MIMETypeData
readSystemMIMETypes :: MIMETypeData -> IO MIMETypeData
readSystemMIMETypes MIMETypeData
mtd =
let tryread :: MIMETypeData -> String -> IO MIMETypeData
tryread :: MIMETypeData -> String -> IO MIMETypeData
tryread MIMETypeData
inputobj String
filename =
do
Either IOException Handle
fn <- IO Handle -> IO (Either IOException Handle)
forall e a. Exception e => IO a -> IO (Either e a)
Control.Exception.try (String -> IOMode -> IO Handle
openFile String
filename IOMode
ReadMode)
case Either IOException Handle
fn of
Left (IOException
_ :: Control.Exception.IOException) -> MIMETypeData -> IO MIMETypeData
forall (m :: * -> *) a. Monad m => a -> m a
return MIMETypeData
inputobj
Right Handle
h -> do
MIMETypeData
x <- MIMETypeData -> Bool -> Handle -> IO MIMETypeData
hReadMIMETypes MIMETypeData
inputobj Bool
True Handle
h
Handle -> IO ()
hClose Handle
h
MIMETypeData -> IO MIMETypeData
forall (m :: * -> *) a. Monad m => a -> m a
return MIMETypeData
x
in
do
(MIMETypeData -> String -> IO MIMETypeData)
-> MIMETypeData -> [String] -> IO MIMETypeData
forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
foldM MIMETypeData -> String -> IO MIMETypeData
tryread MIMETypeData
mtd [String]
defaultfilelocations
getStrict :: MIMETypeData -> Bool -> Map.Map String String
getStrict :: MIMETypeData -> Bool -> Map String String
getStrict MIMETypeData
mtd Bool
True = MIMETypeData -> Map String String
typesMap MIMETypeData
mtd
getStrict MIMETypeData
mtd Bool
False = Map String String -> Map String String -> Map String String
forall k a. Ord k => Map k a -> Map k a -> Map k a
Map.union (MIMETypeData -> Map String String
typesMap MIMETypeData
mtd) (MIMETypeData -> Map String String
commonTypesMap MIMETypeData
mtd)
setStrict :: MIMETypeData -> Bool -> (Map.Map String String -> Map.Map String String) -> MIMETypeData
setStrict :: MIMETypeData
-> Bool -> (Map String String -> Map String String) -> MIMETypeData
setStrict MIMETypeData
mtd Bool
True Map String String -> Map String String
func = MIMETypeData
mtd{typesMap :: Map String String
typesMap = Map String String -> Map String String
func (MIMETypeData -> Map String String
typesMap MIMETypeData
mtd)}
setStrict MIMETypeData
mtd Bool
False Map String String -> Map String String
func = MIMETypeData
mtd{commonTypesMap :: Map String String
commonTypesMap = Map String String -> Map String String
func (MIMETypeData -> Map String String
commonTypesMap MIMETypeData
mtd)}
defaultfilelocations :: [String]
defaultfilelocations :: [String]
defaultfilelocations =
[
String
"/etc/mime.types",
String
"/usr/local/etc/httpd/conf/mime.types",
String
"/usr/local/lib/netscape/mime.types",
String
"/usr/local/etc/httpd/conf/mime.types",
String
"/usr/local/etc/mime.types"
]
default_encodings_map, default_suffix_map, default_types_map, default_common_types :: Map.Map String String
default_encodings_map :: Map String String
default_encodings_map = [(String, String)] -> Map String String
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList [
(String
".Z", String
"compress"),
(String
".gz", String
"gzip"),
(String
".bz2", String
"bzip2")
]
default_suffix_map :: Map String String
default_suffix_map = [(String, String)] -> Map String String
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList [
(String
".tgz", String
".tar.gz"),
(String
".tz", String
".tar.gz"),
(String
".taz", String
".tar.gz")
]
default_types_map :: Map String String
default_types_map = [(String, String)] -> Map String String
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList [
(String
".a", String
"application/octet-stream"),
(String
".ai", String
"application/postscript"),
(String
".aif", String
"audio/x-aiff"),
(String
".aifc", String
"audio/x-aiff"),
(String
".aiff", String
"audio/x-aiff"),
(String
".au", String
"audio/basic"),
(String
".avi", String
"video/x-msvideo"),
(String
".bat", String
"text/plain"),
(String
".bcpio", String
"application/x-bcpio"),
(String
".bin", String
"application/octet-stream"),
(String
".bmp", String
"image/x-ms-bmp"),
(String
".c", String
"text/plain"),
(String
".cdf", String
"application/x-netcdf"),
(String
".cpio", String
"application/x-cpio"),
(String
".csh", String
"application/x-csh"),
(String
".css", String
"text/css"),
(String
".dll", String
"application/octet-stream"),
(String
".doc", String
"application/msword"),
(String
".dot", String
"application/msword"),
(String
".dvi", String
"application/x-dvi"),
(String
".eml", String
"message/rfc822"),
(String
".eps", String
"application/postscript"),
(String
".etx", String
"text/x-setext"),
(String
".exe", String
"application/octet-stream"),
(String
".gif", String
"image/gif"),
(String
".gtar", String
"application/x-gtar"),
(String
".h", String
"text/plain"),
(String
".hdf", String
"application/x-hdf"),
(String
".htm", String
"text/html"),
(String
".html", String
"text/html"),
(String
".ief", String
"image/ief"),
(String
".jpe", String
"image/jpeg"),
(String
".jpeg", String
"image/jpeg"),
(String
".jpg", String
"image/jpeg"),
(String
".js", String
"application/x-javascript"),
(String
".ksh", String
"text/plain"),
(String
".latex", String
"application/x-latex"),
(String
".m1v", String
"video/mpeg"),
(String
".man", String
"application/x-troff-man"),
(String
".me", String
"application/x-troff-me"),
(String
".mht", String
"message/rfc822"),
(String
".mhtml", String
"message/rfc822"),
(String
".mif", String
"application/x-mif"),
(String
".mov", String
"video/quicktime"),
(String
".movie", String
"video/x-sgi-movie"),
(String
".mp2", String
"audio/mpeg"),
(String
".mp3", String
"audio/mpeg"),
(String
".mpa", String
"video/mpeg"),
(String
".mpe", String
"video/mpeg"),
(String
".mpeg", String
"video/mpeg"),
(String
".mpg", String
"video/mpeg"),
(String
".ms", String
"application/x-troff-ms"),
(String
".nc", String
"application/x-netcdf"),
(String
".nws", String
"message/rfc822"),
(String
".o", String
"application/octet-stream"),
(String
".obj", String
"application/octet-stream"),
(String
".oda", String
"application/oda"),
(String
".p12", String
"application/x-pkcs12"),
(String
".p7c", String
"application/pkcs7-mime"),
(String
".pbm", String
"image/x-portable-bitmap"),
(String
".pdf", String
"application/pdf"),
(String
".pfx", String
"application/x-pkcs12"),
(String
".pgm", String
"image/x-portable-graymap"),
(String
".pl", String
"text/plain"),
(String
".png", String
"image/png"),
(String
".pnm", String
"image/x-portable-anymap"),
(String
".pot", String
"application/vnd.ms-powerpoint"),
(String
".ppa", String
"application/vnd.ms-powerpoint"),
(String
".ppm", String
"image/x-portable-pixmap"),
(String
".pps", String
"application/vnd.ms-powerpoint"),
(String
".ppt", String
"application/vnd.ms-powerpoint"),
(String
".ps", String
"application/postscript"),
(String
".pwz", String
"application/vnd.ms-powerpoint"),
(String
".py", String
"text/x-python"),
(String
".pyc", String
"application/x-python-code"),
(String
".pyo", String
"application/x-python-code"),
(String
".qt", String
"video/quicktime"),
(String
".ra", String
"audio/x-pn-realaudio"),
(String
".ram", String
"application/x-pn-realaudio"),
(String
".ras", String
"image/x-cmu-raster"),
(String
".rdf", String
"application/xml"),
(String
".rgb", String
"image/x-rgb"),
(String
".roff", String
"application/x-troff"),
(String
".rtx", String
"text/richtext"),
(String
".sgm", String
"text/x-sgml"),
(String
".sgml", String
"text/x-sgml"),
(String
".sh", String
"application/x-sh"),
(String
".shar", String
"application/x-shar"),
(String
".snd", String
"audio/basic"),
(String
".so", String
"application/octet-stream"),
(String
".src", String
"application/x-wais-source"),
(String
".sv4cpio", String
"application/x-sv4cpio"),
(String
".sv4crc", String
"application/x-sv4crc"),
(String
".swf", String
"application/x-shockwave-flash"),
(String
".t", String
"application/x-troff"),
(String
".tar", String
"application/x-tar"),
(String
".tcl", String
"application/x-tcl"),
(String
".tex", String
"application/x-tex"),
(String
".texi", String
"application/x-texinfo"),
(String
".texinfo", String
"application/x-texinfo"),
(String
".tif", String
"image/tiff"),
(String
".tiff", String
"image/tiff"),
(String
".tr", String
"application/x-troff"),
(String
".tsv", String
"text/tab-separated-values"),
(String
".txt", String
"text/plain"),
(String
".ustar", String
"application/x-ustar"),
(String
".vcf", String
"text/x-vcard"),
(String
".wav", String
"audio/x-wav"),
(String
".wiz", String
"application/msword"),
(String
".xbm", String
"image/x-xbitmap"),
(String
".xlb", String
"application/vnd.ms-excel"),
(String
".xls", String
"application/vnd.ms-excel"),
(String
".xml", String
"text/xml"),
(String
".xpm", String
"image/x-xpixmap"),
(String
".xsl", String
"application/xml"),
(String
".xwd", String
"image/x-xwindowdump"),
(String
".zip", String
"application/zip")
]
default_common_types :: Map String String
default_common_types = [(String, String)] -> Map String String
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList [
(String
".jpg", String
"image/jpg"),
(String
".mid", String
"audio/midi"),
(String
".midi", String
"audio/midi"),
(String
".pct", String
"image/pict"),
(String
".pic", String
"image/pict"),
(String
".pict", String
"image/pict"),
(String
".rtf", String
"application/rtf"),
(String
".xul", String
"text/xul")
]