X-Git-Url: http://git.cielonegro.org/gitweb.cgi?p=Lucu.git;a=blobdiff_plain;f=Network%2FHTTP%2FLucu%2FMIMEType%2FGuess.hs;h=7fe58206b5dcb86cd15538c4906f2f86ed0a09d8;hp=309f7fe0621a427ca1fb1ed0bb1ec09e90e3acee;hb=a44a96d95b5fcbaf24a21c0336046ce0c3bab614;hpb=c6b11025d1f81c668e9995e856b7bb34175230d3 diff --git a/Network/HTTP/Lucu/MIMEType/Guess.hs b/Network/HTTP/Lucu/MIMEType/Guess.hs index 309f7fe..7fe5820 100644 --- a/Network/HTTP/Lucu/MIMEType/Guess.hs +++ b/Network/HTTP/Lucu/MIMEType/Guess.hs @@ -1,6 +1,9 @@ module Network.HTTP.Lucu.MIMEType.Guess - ( parseExtMapFile -- FilePath -> IO (Map String MIMEType) - , outputExtMapAsHS -- Map String MIMEType -> FilePath -> IO () + ( ExtMap + , guessTypeByFileName -- ExtMap -> FilePath -> Maybe MIMEType + + , parseExtMapFile -- FilePath -> IO ExtMap + , outputExtMapAsHS -- ExtMap -> FilePath -> IO () ) where @@ -14,11 +17,20 @@ import Language.Haskell.Syntax import Network.HTTP.Lucu.MIMEType import Network.HTTP.Lucu.Parser import Network.HTTP.Lucu.Parser.Http +import Network.HTTP.Lucu.Utils import System.IO -import Debug.Trace +type ExtMap = Map String MIMEType + + +guessTypeByFileName :: ExtMap -> FilePath -> Maybe MIMEType +guessTypeByFileName extMap fpath + = let ext = head $ reverse $ splitBy (== '.') fpath + in + M.lookup ext extMap >>= return + -parseExtMapFile :: FilePath -> IO (Map String MIMEType) +parseExtMapFile :: FilePath -> IO ExtMap parseExtMapFile fpath = do file <- B.readFile fpath case parse (allowEOF extMapP) file of @@ -56,7 +68,7 @@ compile = M.fromList . foldr (++) [] . map tr tr (mime, exts) = [ (ext, mime) | ext <- exts ] -outputExtMapAsHS :: Map String MIMEType -> FilePath -> IO () +outputExtMapAsHS :: ExtMap -> FilePath -> IO () outputExtMapAsHS extMap fpath = let hsModule = HsModule undefined modName (Just exports) imports decls modName = Module "Network.HTTP.Lucu.MIMEType.DefaultExtensionMap"