implemented page listing

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

diff --git a/Rakka/Storage/DefaultPage.hs b/Rakka/Storage/DefaultPage.hs
index bba22798d4597a15442ecf762517169d140ca76f..c8efd4c800a0a09f3bb9887ba2df82c88614715c 100644 (file)
--- a/Rakka/Storage/DefaultPage.hs
+++ b/Rakka/Storage/DefaultPage.hs
@@ -1,5 +1,6 @@
 module Rakka.Storage.DefaultPage
     ( findAllDefaultPages
+    , getDefaultDirContents
     , loadDefaultPage
     )
     where
@@ -43,6 +44,32 @@ findAllDefaultPages
             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' dirPath
+          = getDirectoryContents (dirPath </> encodePageName dir)
+            >>=
+            return . S.fromList . map (m dirPath) . filter f
+
+      m :: FilePath -> FilePath -> PageName
+      m dirPath = (dir </>) . decodePageName . makeRelative dirPath . dropExtension
+
+      f :: FilePath -> Bool
+      f "."  = False
+      f ".." = False
+      f _    = True
+
+
 loadDefaultPage :: PageName -> IO (Maybe Page)
 loadDefaultPage name
     -- ./defaultPages が存在するなら、./defaultPages/Foo.xml を探す。無
@@ -88,15 +115,13 @@ loadPageFileA
                     -< 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
+                         }