preview backend now fully works!

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

diff --git a/Rakka.cabal b/Rakka.cabal
index 08df4155f09c26245f7e11af1a82a9e37ad359cc..afca2002dff8e3b48e209d37c8fc03ea48ce1d2e 100644 (file)
--- 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 01c75e105091994cb43a1c30abb3ab1ff3640cff..670edd88273aef65dade948c1a6627a5d04fa73d 100644 (file)
--- 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 9eb667c115971c10d816f0176e8d9bda2b4a1632..0fddc6d64127baf25a1e5adbe19b58b5e758d039 100644 (file)
--- 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