Implemented findChangedPagesAtRevision

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

diff --git a/Rakka/Storage/Repos.hs b/Rakka/Storage/Repos.hs
index 92fa6b8949c09acf664dcf558aeccb4e8e1d0643..55117ab1beac7836e2c3f163577647ffd002679c 100644 (file)
--- a/Rakka/Storage/Repos.hs
+++ b/Rakka/Storage/Repos.hs
@@ -1,10 +1,16 @@
 module Rakka.Storage.Repos
-    ( loadPageInRepository
+    ( findAllPagesInRevision
+    , findChangedPagesAtRevision
+    , loadPageInRepository
     )
     where
 
+import           Control.Monad
+import           Data.List
 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 +19,61 @@ 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
+
+
+findChangedPagesAtRevision :: Repository -> RevNum -> IO (Set PageName)
+findChangedPagesAtRevision repos rev
+    = do fs <- getRepositoryFS repos
+         withRevision fs rev
+             $ getPathsChanged >>= return . foldl accumulatePages S.empty . map fst
+    where
+      accumulatePages :: Set PageName -> FilePath -> Set PageName
+      accumulatePages s path
+          | "/pages/" `isPrefixOf` path && ".page" `isSuffixOf` path
+              = let encoded = makeRelative "/pages" $ dropExtension path
+                    name    = decodePageName encoded
+                in
+                  S.insert name s
+          | otherwise
+              = s
+
+
 loadPageInRepository :: Repository -> PageName -> Maybe RevNum -> IO (Maybe Page)
 loadPageInRepository repos name rev
     = do fs   <- getRepositoryFS repos
@@ -34,7 +89,7 @@ loadPageInRepository repos name rev
                         -> return Nothing
     where
       path :: FilePath
-      path = "pages" </> encodePageName name
+      path = "pages" </> encodePageName name <.> "page"
 
       loadPage' :: Rev Page
       loadPage' = do redirect <- getNodeProp path "rakka:redirect"