where
import qualified Codec.Binary.Base64 as B64
+import Codec.Binary.UTF8.String
import Control.Arrow
import Control.Arrow.ArrowIO
import Control.Arrow.ArrowList
import qualified Data.ByteString.Lazy as L
-import Data.Encoding
-import Data.Encoding.UTF8
import qualified Data.Map as M
import Data.Set (Set)
import qualified Data.Set as S
+import Data.Time
+import Data.Time.Clock.POSIX
import Paths_Rakka -- Cabal が用意する。
import Rakka.Page
import Rakka.Utils
-import System.FilePath
-import System.FilePath.Find
import System.Directory
-import System.Time
+import System.FilePath
+import System.FilePath.Find hiding (fileName, modificationTime)
+import System.Posix.Files
import Text.XML.HXT.Arrow.ReadDocument
import Text.XML.HXT.Arrow.XmlArrow
import Text.XML.HXT.Arrow.XmlIOStateArrow
loadDefaultPage :: PageName -> IO (Maybe Page)
-loadDefaultPage pageName
+loadDefaultPage name
-- ./defaultPages が存在するなら、./defaultPages/Foo を探す。無けれ
-- ば Cabal で defaultPages/Foo を探す。
- = do let pagePath = "defaultPages/" ++ encodePageName pageName
+ = do let pagePath = "defaultPages/" ++ encodePageName name
localDirExists <- doesLocalDirExist
if localDirExists then
tryLoad fpath
= do exists <- doesFileExist fpath
if exists then
- return . Just =<< loadPageFile pageName fpath
+ return . Just =<< loadPageFile name fpath
else
return Nothing
, (a_check_namespaces , v_1)
, (a_remove_whitespace, v_1)
] -< fpath
- lastMod <- arrIO (\ x -> getModificationTime x >>= toCalendarTime) -< fpath
+ lastMod <- arrIO (\ x -> getFileStatus x
+ >>=
+ return . posixSecondsToUTCTime . fromRational . toRational . modificationTime)
+ -< fpath
parsePage -< (name, lastMod, tree)
-parsePage :: (ArrowXml a, ArrowChoice a) => a (PageName, CalendarTime, XmlTree) Page
+parsePage :: (ArrowXml a, ArrowChoice a) => a (PageName, UTCTime, XmlTree) Page
parsePage
= proc (name, lastMod, tree)
-> do redirect <- maybeA (getXPathTreesInDoc "/page/@redirect/text()" >>> getText) -< tree
})
-parseEntity :: (ArrowXml a, ArrowChoice a) => a (PageName, CalendarTime, XmlTree) Page
+parseEntity :: (ArrowXml a, ArrowChoice a) => a (PageName, UTCTime, XmlTree) Page
parseEntity
= proc (name, lastMod, tree)
-> do mimeType <- (getXPathTreesInDoc "/page/@type/text()" >>> getText
let (isBinary, content)
= case (textData, binaryData) of
- (Just text, _ ) -> (False, encodeLazy UTF8 text )
- (_ , Just binary) -> (True , L.pack $ B64.decode binary)
+ (Just text, Nothing ) -> (False, L.pack $ encode text )
+ (Nothing , Just binary) -> (True , L.pack $ B64.decode binary)
+ _ -> error "one of textData or binaryData is required"
returnA -< Entity {
pageName = name