wrote much code...

[Rakka.git] / Rakka / Storage / DefaultPage.hs

diff --git a/Rakka/Storage/DefaultPage.hs b/Rakka/Storage/DefaultPage.hs
index 9cdaf45afed2152cc8b37b7753e985dab48a1461..5362cc7d33771cd3a8c5ec89c6760a7c6ebe61cf 100644 (file)
--- a/Rakka/Storage/DefaultPage.hs
+++ b/Rakka/Storage/DefaultPage.hs
@@ -3,11 +3,13 @@ module Rakka.Storage.DefaultPage
     )
     where
 
-import qualified Codec.Binary.Base64.String as B64
+import qualified Codec.Binary.Base64 as B64
 import           Control.Arrow
 import           Control.Arrow.ArrowIO
 import           Control.Arrow.ArrowList
-import qualified Data.ByteString.Lazy.Char8 as L8
+import qualified Data.ByteString.Lazy as L
+import           Data.Encoding
+import           Data.Encoding.UTF8
 import           Paths_Rakka -- Cabal が用意する。
 import           Rakka.Page
 import           Rakka.Utils
@@ -23,13 +25,13 @@ import           Text.XML.HXT.DOM.XmlKeywords
 
 loadDefaultPage :: PageName -> IO (Maybe Page)
 loadDefaultPage pageName
-    -- ./data/Foo を探した後、Cabal で defaultPages/Foo を探す。
-    = do let pagePath = encodePageName pageName
-         isInDataDir <- doesFileExist ("./data/" ++ pagePath)
+    -- ./defaultPages/Foo を探した後、Cabal で defaultPages/Foo を探す。
+    = do let pagePath = "defaultPages/" ++ encodePageName pageName
+         isInDataDir <- doesFileExist pagePath
          if isInDataDir then
-             return . Just =<< loadPageFile pageName ("./data/" ++ pagePath)
+             return . Just =<< loadPageFile pageName pagePath
            else
-             do fpath       <- getDataFileName ("defaultPages/" ++ pagePath)
+             do fpath       <- getDataFileName pagePath
                 isInstalled <- doesFileExist fpath
                 if isInstalled then
                     return . Just =<< loadPageFile pageName fpath
@@ -79,7 +81,7 @@ parseEntity
     -> do mimeType <- (getXPathTreesInDoc "/page/@type/text()" >>> getText
                        >>> arr read) -< tree
 
-          isTheme  <- (maybeA (getXPathTreesInDoc "/page/@type/text()" >>> getText)
+          isTheme  <- (maybeA (getXPathTreesInDoc "/page/@isTheme/text()" >>> getText)
                        >>> defaultTo "no"
                        >>> parseYesOrNo) -< tree
           isFeed   <- (maybeA (getXPathTreesInDoc "/page/@isFeed/text()" >>> getText)
@@ -102,12 +104,13 @@ parseEntity
                                &&&
                                getAttrValue0 "page")) -< tree
 
-          textData   <- maybeA (getXPathTreesInDoc "/page/textData"   >>> getText) -< tree
-          binaryData <- maybeA (getXPathTreesInDoc "/page/binaryData" >>> getText) -< tree
+          textData   <- maybeA (getXPathTreesInDoc "/page/textData/text()"   >>> getText) -< tree
+          binaryData <- maybeA (getXPathTreesInDoc "/page/binaryData/text()" >>> getText) -< tree
 
-          let content = case (textData, binaryData) of
-                          (Just text, _          ) -> L8.pack text
-                          (_        , Just binary) -> L8.pack $ B64.decode binary
+          let (isBinary, content)
+                  = case (textData, binaryData) of
+                      (Just text, _          ) -> (False, encodeLazy UTF8 text      )
+                      (_        , Just binary) -> (True , L.pack $ B64.decode binary)
 
           returnA -< Entity {
                         pageName      = name
@@ -116,6 +119,7 @@ parseEntity
                       , pageIsFeed    = isFeed
                       , pageIsLocked  = isLocked
                       , pageIsBoring  = isBoring
+                      , pageIsBinary  = isBinary
                       , pageRevision  = Nothing
                       , pageLastMod   = lastMod
                       , pageSummary   = summary