Added suffixes to each page files

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

diff --git a/Rakka/Storage/Repos.hs b/Rakka/Storage/Repos.hs
index 92fa6b8949c09acf664dcf558aeccb4e8e1d0643..d42fdb90bd3c46ac28bc0aeee9989c528e36fe0b 100644 (file)
--- a/Rakka/Storage/Repos.hs
+++ b/Rakka/Storage/Repos.hs
@@ -1,10 +1,13 @@
 module Rakka.Storage.Repos
-    ( loadPageInRepository
+    ( findAllPagesInRevision
+    , loadPageInRepository
     )
     where
 
 import qualified Data.Map as M
 import           Data.Maybe
+import           Data.Set (Set)
+import qualified Data.Set as S hiding (Set)
 import           Data.Time
 import           Network.HTTP.Lucu hiding (redirect)
 import           Rakka.Page
@@ -13,12 +16,44 @@ import           Rakka.Utils
 import           Rakka.W3CDateTime
 import           Subversion.Types
 import           Subversion.FileSystem
+import           Subversion.FileSystem.DirEntry
 import           Subversion.FileSystem.Revision
 import           Subversion.FileSystem.Root
 import           Subversion.Repository
 import           System.FilePath.Posix
 
 
+findAllPagesInRevision :: Repository -> RevNum -> IO (Set PageName)
+findAllPagesInRevision repos rev
+    = do fs <- getRepositoryFS repos
+         withRevision fs rev
+             $ do exists <- isDirectory root
+                  if exists then
+                      traverse root
+                    else
+                      return S.empty
+    where
+      root :: FilePath
+      root = "/pages"
+
+      traverse :: FilePath -> Rev (Set PageName)
+      traverse dir
+          = getDirEntries dir >>= mapM (traverse' dir) >>= return . S.unions
+
+      traverse' :: FilePath -> DirEntry -> Rev (Set PageName)
+      traverse' dir entry
+          = let path = dir </> entName entry
+            in
+              do kind <- checkPath path
+                 case kind of
+                   NoNode   -> return S.empty
+                   FileNode -> return $ S.singleton (decodePath path)
+                   DirNode  -> traverse path
+
+      decodePath :: FilePath -> PageName
+      decodePath = decodePageName . makeRelative root . dropExtension
+
+
 loadPageInRepository :: Repository -> PageName -> Maybe RevNum -> IO (Maybe Page)
 loadPageInRepository repos name rev
     = do fs   <- getRepositoryFS repos
@@ -34,7 +69,7 @@ loadPageInRepository repos name rev
                         -> return Nothing
     where
       path :: FilePath
-      path = "pages" </> encodePageName name
+      path = "pages" </> (encodePageName name `addExtension` "page")
 
       loadPage' :: Rev Page
       loadPage' = do redirect <- getNodeProp path "rakka:redirect"