X-Git-Url: http://git.cielonegro.org/gitweb.cgi?a=blobdiff_plain;f=Network%2FHTTP%2FLucu%2FMIMEType%2FGuess.hs;h=db51e65cdce31d6bef85c93aeb32fe786ed51af1;hb=175e14b3b144537644e65ca76f1fca5c56fd44e9;hp=309f7fe0621a427ca1fb1ed0bb1ec09e90e3acee;hpb=c6b11025d1f81c668e9995e856b7bb34175230d3;p=Lucu.git diff --git a/Network/HTTP/Lucu/MIMEType/Guess.hs b/Network/HTTP/Lucu/MIMEType/Guess.hs index 309f7fe..db51e65 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 = last $ 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" @@ -90,16 +102,16 @@ outputExtMapAsHS extMap fpath mimeToExp (MIMEType maj min params) = foldl appendParam (HsInfixApp (HsLit (HsString maj)) - (HsQVarOp (UnQual (HsSymbol "+/+"))) + (HsQVarOp (UnQual (HsSymbol ""))) (HsLit (HsString min))) params appendParam :: HsExp -> (String, String) -> HsExp appendParam x param - = HsInfixApp x (HsQVarOp (UnQual (HsSymbol "+:+"))) $ paramToExp param + = HsInfixApp x (HsQVarOp (UnQual (HsSymbol "<:>"))) $ paramToExp param paramToExp :: (String, String) -> HsExp paramToExp (name, value) = HsInfixApp (HsLit (HsString name)) - (HsQVarOp (UnQual (HsSymbol "+=+"))) + (HsQVarOp (UnQual (HsSymbol "<=>"))) (HsLit (HsString value)) \ No newline at end of file