implemented binary file preview/upload

[Rakka.git] / Rakka / Page.hs

diff --git a/Rakka/Page.hs b/Rakka/Page.hs
index 2462bab30f14d44004fa4fd61e81972fa385fb96..f701d92078e757a0ada421d7d54f33e8d4d2b609 100644 (file)
--- a/Rakka/Page.hs
+++ b/Rakka/Page.hs
@@ -10,6 +10,7 @@ module Rakka.Page
 
     , pageName
     , pageUpdateInfo
+    , pageRevision
 
     , encodePageName
     , decodePageName
@@ -30,7 +31,7 @@ module Rakka.Page
     where
 
 import qualified Codec.Binary.Base64 as B64
-import           Codec.Binary.UTF8.String
+import qualified Codec.Binary.UTF8.String as UTF8
 import           Control.Arrow
 import           Control.Arrow.ArrowIO
 import           Control.Arrow.ArrowList
@@ -108,19 +109,26 @@ pageName :: Page -> PageName
 pageName p
     | isRedirect p = redirName p
     | isEntity   p = entityName p
-    | otherwise    = fail "neither redirection nor entity"
+    | otherwise    = error "neither redirection nor entity"
 
 
 pageUpdateInfo :: Page -> Maybe UpdateInfo
 pageUpdateInfo p
     | isRedirect p = redirUpdateInfo p
     | isEntity   p = entityUpdateInfo p
-    | otherwise    = fail "neither redirection nor entity"
+    | otherwise    = error "neither redirection nor entity"
+
+
+pageRevision :: Page -> RevNum
+pageRevision p
+    | isRedirect p = redirRevision p
+    | isEntity   p = entityRevision p
+    | otherwise    = error "neither redirection nor entity"
 
 
 -- UTF-8 に encode してから 0x20 - 0x7E の範圍を除いて URI escape する。
 encodePageName :: PageName -> FilePath
-encodePageName = escapeURIString isSafeChar . encodeString . fixPageName
+encodePageName = escapeURIString isSafeChar . UTF8.encodeString . fixPageName
     where
       fixPageName :: PageName -> PageName
       fixPageName = (\ (x:xs) -> toUpper x : xs) . map (\ c -> if c == ' ' then '_' else c)
@@ -136,11 +144,11 @@ isSafeChar c
 
 -- URI unescape して UTF-8 から decode する。
 decodePageName :: FilePath -> PageName
-decodePageName = decodeString . unEscapeString
+decodePageName = UTF8.decodeString . unEscapeString
 
 
 encodeFragment :: String -> String
-encodeFragment = escapeURIString isSafeChar . encodeString
+encodeFragment = escapeURIString isSafeChar . UTF8.encodeString
 
 
 entityFileName' :: Page -> String
@@ -304,7 +312,7 @@ xmlizePage
                                 )
                             else
                                 ( eelem "textData"
-                                  += txt (decode $ L.unpack $ entityContent page)
+                                  += txt (UTF8.decode $ L.unpack $ entityContent page)
                                 )
                           )
                      )) -<< ()
@@ -331,8 +339,7 @@ parseEntity
     = proc (name, tree)
     -> do updateInfo <- maybeA parseUpdateInfo -< tree
 
-          mimeType <- (getXPathTreesInDoc "/page/@type/text()" >>> getText
-                       >>> arr read) -< tree
+          mimeTypeStr <- withDefault (getXPathTreesInDoc "/page/@type/text()" >>> getText) "" -< tree
 
           lang     <- maybeA (getXPathTreesInDoc "/page/@lang/text()"     >>> getText) -< tree
           fileName <- maybeA (getXPathTreesInDoc "/page/@filename/text()" >>> getText) -< tree
@@ -361,9 +368,17 @@ parseEntity
 
           let (isBinary, content)
                   = case (textData, binaryData) of
-                      (Just text, Nothing    ) -> (False, L.pack $ encode text      )
+                      (Just text, Nothing    ) -> (False, L.pack $ UTF8.encode text )
                       (Nothing  , Just binary) -> (True , L.pack $ B64.decode binary)
                       _                        -> error "one of textData or binaryData is required"
+              mimeType
+                  =  if isBinary then
+                         if null mimeTypeStr then
+                             guessMIMEType content
+                         else
+                             read mimeTypeStr
+                     else
+                         read mimeTypeStr
 
           returnA -< Entity {
                         entityName       = name