</> is better than +/+

[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 309f7fe0621a427ca1fb1ed0bb1ec09e90e3acee..db51e65cdce31d6bef85c93aeb32fe786ed51af1 100644 (file)
--- 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