From: pho <pho@cielonegro.org>
Date: Sun, 6 Jan 2008 04:43:46 +0000 (+0900)
Subject: preview backend now fully works!
X-Git-Url: https://git.cielonegro.org/gitweb.cgi?a=commitdiff_plain;h=d86c5b3ded23eaa215d1903495579c19c7daf5bb;p=Rakka.git

preview backend now fully works!

darcs-hash:20080106044346-62b54-2a1d2d2d5d0bab5a7bbe2fd572841529d00e0c55.gz
---

diff --git a/Rakka.cabal b/Rakka.cabal
index 08df415..afca200 100644
--- a/Rakka.cabal
+++ b/Rakka.cabal
@@ -42,7 +42,8 @@ Executable rakka
     Build-Depends:
         Crypto, FileManip, HUnit, HsHyperEstraier, HsSVN, Lucu, base,
         bytestring, containers, directory, utf8-string, filepath,
-        hslogger, hxt, mtl, network, parsec, stm, time, unix, zlib
+        hslogger, hxt, magic, mtl, network, parsec, stm, time, unix,
+        zlib
     Main-Is:
         Main.hs
     Other-Modules:
diff --git a/Rakka/Resource/Render.hs b/Rakka/Resource/Render.hs
index 01c75e1..670edd8 100644
--- a/Rakka/Resource/Render.hs
+++ b/Rakka/Resource/Render.hs
@@ -14,6 +14,7 @@ import           Network.HTTP.Lucu
 import           Network.HTTP.Lucu.Utils
 import           Rakka.Environment
 import           Rakka.Page
+import           Rakka.Utils
 import           Rakka.Wiki
 import           Rakka.Wiki.Engine
 import           Rakka.Wiki.Parser
@@ -65,8 +66,12 @@ resRender env
 -}
 handleRender :: Environment -> PageName -> Resource ()
 handleRender env name
-    = do cType <- guessTypeIfNeeded =<< getContentType
-         bin   <- inputLBS defaultLimit
+    = do bin    <- inputLBS defaultLimit
+         cTypeM <- getContentType
+
+         let cType = case cTypeM of
+                       Just t  -> t
+                       Nothing -> guessMIMEType bin
 
          setContentType $ read "text/xml"
          [xmlStr] <- liftIO $ runX ( setErrorMsgHandler False fail
@@ -78,10 +83,6 @@ handleRender env name
                                      writeDocumentToString [ (a_indent, v_1) ]
                                    )
          output xmlStr
-    where
-      guessTypeIfNeeded :: Maybe MIMEType -> Resource MIMEType
-      guessTypeIfNeeded (Just t) = return t
-      guessTypeIfNeeded Nothing  = fail "not impl"
 
 
 render :: (ArrowXml a, ArrowChoice a, ArrowIO a) =>
diff --git a/Rakka/Utils.hs b/Rakka/Utils.hs
index 9eb667c..0fddc6d 100644
--- a/Rakka/Utils.hs
+++ b/Rakka/Utils.hs
@@ -4,11 +4,17 @@ module Rakka.Utils
     , maybeA
     , deleteIfEmpty
     , chomp
+    , guessMIMEType
     )
     where
 
 import           Control.Arrow
 import           Control.Arrow.ArrowList
+import qualified Data.ByteString.Lazy as Lazy (ByteString)
+import qualified Data.ByteString.Lazy.Char8 as L8 hiding (ByteString)
+import           Magic
+import           Network.HTTP.Lucu
+import           System.IO.Unsafe
 
 
 yesOrNo :: Bool -> String
@@ -41,3 +47,13 @@ deleteIfEmpty
 
 chomp :: String -> String
 chomp = reverse . snd . break (/= '\n') . reverse
+
+
+guessMIMEType :: Lazy.ByteString -> MIMEType
+guessMIMEType = read . unsafePerformIO . magicString magic . L8.unpack
+    where
+      magic :: Magic
+      magic = unsafePerformIO
+              $ do m <- magicOpen [MagicMime]
+                   magicLoadDefault m
+                   return m