Implemented findAllPagesInRevision

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

diff --git a/Rakka/Storage/Repos.hs b/Rakka/Storage/Repos.hs
index 92fa6b8949c09acf664dcf558aeccb4e8e1d0643..3b7fe542804fe5b0dd9c74d82fcfd786075986d3 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
+
+
 loadPageInRepository :: Repository -> PageName -> Maybe RevNum -> IO (Maybe Page)
 loadPageInRepository repos name rev
     = do fs   <- getRepositoryFS repos