Say good bye to the ugliness of "text" </> "plain".

[Lucu.git] / Network / HTTP / Lucu / MIMEType / Guess.hs

diff --git a/Network/HTTP/Lucu/MIMEType/Guess.hs b/Network/HTTP/Lucu/MIMEType/Guess.hs
index 93a1479837fb4c98f015faa163f48430d9778dd3..6f4632609c6b1b2ef0d940de4cdc6b5003f470ef 100644 (file)
--- a/Network/HTTP/Lucu/MIMEType/Guess.hs
+++ b/Network/HTTP/Lucu/MIMEType/Guess.hs
@@ -12,7 +12,6 @@ module Network.HTTP.Lucu.MIMEType.Guess
     where
 
 import qualified Data.ByteString.Lazy.Char8 as B
-import           Data.ByteString.Lazy.Char8 (ByteString)
 import qualified Data.Map as M
 import           Data.Map (Map)
 import           Data.Maybe
@@ -30,14 +29,16 @@ type ExtMap = Map String MIMEType
 -- |Guess the MIME Type of file.
 guessTypeByFileName :: ExtMap -> FilePath -> Maybe MIMEType
 guessTypeByFileName extMap fpath
-    = let ext = last $ splitBy (== '.') fpath
+    = extMap `seq` fpath `seq`
+      let ext = last $ splitBy (== '.') fpath
       in
         M.lookup ext extMap >>= return
 
 -- |Read an Apache mime.types and parse it.
 parseExtMapFile :: FilePath -> IO ExtMap
 parseExtMapFile fpath
-    = do file <- B.readFile fpath
+    = fpath `seq`
+      do file <- B.readFile fpath
          case parse (allowEOF extMapP) file of
            (Success xs, _) -> return $ compile xs
            (_, input')     -> let near = B.unpack $ B.take 100 input'
@@ -87,10 +88,9 @@ serializeExtMap extMap moduleName variableName
     = let hsModule = HsModule undefined modName (Just exports) imports decls
           modName  = Module moduleName
           exports  = [HsEVar (UnQual (HsIdent variableName))]
-          imports  = [ HsImportDecl undefined (Module "Network.HTTP.Lucu.MIMEType") False Nothing Nothing
+          imports  = [ HsImportDecl undefined (Module "Network.HTTP.Lucu.MIMEType") False Nothing (Just (False, []))
                      , HsImportDecl undefined (Module "Network.HTTP.Lucu.MIMEType.Guess") False Nothing Nothing
                      , HsImportDecl undefined (Module "Data.Map") True (Just (Module "M")) Nothing
-                     , HsImportDecl undefined (Module "Data.Map") False Nothing (Just (False, [HsIAbs (HsIdent "Map")]))
                      ]
           decls    = [ HsTypeSig undefined [HsIdent variableName]
                                      (HsQualType []
@@ -113,19 +113,5 @@ serializeExtMap extMap moduleName variableName
           = HsTuple [HsLit (HsString ext), mimeToExp mime]
                     
       mimeToExp :: MIMEType -> HsExp
-      mimeToExp (MIMEType maj min params)
-          = foldl appendParam (HsInfixApp
-                               (HsLit (HsString maj))
-                               (HsQVarOp (UnQual (HsSymbol "</>")))
-                               (HsLit (HsString min))) params
-
-      appendParam :: HsExp -> (String, String) -> HsExp
-      appendParam x param
-          = HsInfixApp x (HsQVarOp (UnQual (HsSymbol "<:>"))) $ paramToExp param
-
-      paramToExp :: (String, String) -> HsExp
-      paramToExp (name, value)
-          = HsInfixApp
-            (HsLit (HsString name))
-            (HsQVarOp (UnQual (HsSymbol "<=>")))
-            (HsLit (HsString value))
\ No newline at end of file
+      mimeToExp mt
+          = HsApp (HsVar (UnQual (HsIdent "read"))) (HsLit (HsString $ show mt))