From: pho 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