From: pho <pho@cielonegro.org>
Date: Wed, 14 Nov 2007 03:50:44 +0000 (+0900)
Subject: Implemented findAllPagesInRevision
X-Git-Url: http://git.cielonegro.org/gitweb.cgi?p=Rakka.git;a=commitdiff_plain;h=04f57f2ee2e6e696b4bf0bbd8cda51cdc3d7b4a4

Implemented findAllPagesInRevision

darcs-hash:20071114035044-62b54-0b95eb93976d26c9b0f4c8db843065ccd15f5717.gz
---

diff --git a/Rakka/Storage/Impl.hs b/Rakka/Storage/Impl.hs
index 44df20d..a6d0056 100644
--- a/Rakka/Storage/Impl.hs
+++ b/Rakka/Storage/Impl.hs
@@ -43,8 +43,9 @@ getPage' repos name rev
 
 findAllPages :: Repository -> RevNum -> IO (Set PageName)
 findAllPages _     0   = findAllDefaultPages
-findAllPages repos rev
-    = findAllDefaultPages -- FIXME
+findAllPages repos rev = do reposPages   <- findAllPagesInRevision repos rev
+                            defaultPages <- findAllDefaultPages
+                            return (reposPages `S.union` defaultPages)
 
 
 findChangedPages :: Repository -> RevNum -> RevNum -> IO (Set PageName)
diff --git a/Rakka/Storage/Repos.hs b/Rakka/Storage/Repos.hs
index 92fa6b8..3b7fe54 100644
--- 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