module Rakka.Storage.DefaultPage
( findAllDefaultPages
+ , getDefaultDirContents
, loadDefaultPage
)
where
-
import Control.Arrow
import Control.Arrow.ArrowIO
import Control.Arrow.ArrowList
import System.FilePath.Find hiding (fileName, modificationTime)
import System.Posix.Files
import Text.XML.HXT.Arrow.ReadDocument
-import Text.XML.HXT.Arrow.XmlIOStateArrow
import Text.XML.HXT.DOM.XmlKeywords
return . S.fromList . map (decodePageName . makeRelative dirPath . dropExtension)
+getDefaultDirContents :: PageName -> IO (Set PageName)
+getDefaultDirContents dir
+ -- ./defaultPages が存在するなら、その中を探す。無ければ Cabal で
+ -- defaultPages を探す。
+ = do localDirExists <- doesLocalDirExist
+ if localDirExists then
+ getDir' "defaultPages"
+ else
+ -- FIXME: この getDataFileName の使ひ方は undocumented
+ getDir' =<< getDataFileName "defaultPages"
+ where
+ getDir' :: FilePath -> IO (Set PageName)
+ getDir' basePath
+ = do let childDirPath = basePath </> encodePageName dir
+ exists <- doesDirectoryExist childDirPath
+ if exists then
+ getDirectoryContents childDirPath
+ >>=
+ return . S.fromList . map (m basePath) . filter f
+ else
+ return S.empty
+
+ m :: FilePath -> FilePath -> PageName
+ m basePath = (dir </>) . decodePageName . makeRelative basePath . dropExtension
+
+ f :: FilePath -> Bool
+ f "." = False
+ f ".." = False
+ f _ = True
+
+
loadDefaultPage :: PageName -> IO (Maybe Page)
loadDefaultPage name
-- ./defaultPages が存在するなら、./defaultPages/Foo.xml を探す。無
-< fpath
page <- parseXmlizedPage -< (name, tree)
- case page of
- Redirection _ _ _ _ _
- -> returnA -< page {
- redirRevision = 0
- , redirLastMod = lastMod
- }
-
- Entity _ _ _ _ _ _ _ _ _ _ _ _ _ _ _
- -> returnA -< page {
- entityRevision = 0
- , entityLastMod = lastMod
- }
+ if isEntity page then
+ returnA -< page {
+ entityRevision = 0
+ , entityLastMod = lastMod
+ }
+ else
+ returnA -< page {
+ redirRevision = 0
+ , redirLastMod = lastMod
+ }