Implemented findChangedPagesAtRevision

darcs-hash:20071114054129-62b54-aae4edc67902cf668b77c9b4091714a113dbaae9.gz

diff --git a/Rakka/Page.hs b/Rakka/Page.hs
index 453ed841000eb18d4859a8ccfe0280a088066369..c6469a7f10552ca37fa97f5e1f2b338e8c16875d 100644 (file)
--- a/Rakka/Page.hs
+++ b/Rakka/Page.hs
@@ -60,6 +60,7 @@ data Page
       , pageOtherLang :: !(Map LanguageTag PageName)
       , pageContent   :: !Lazy.ByteString
       }
+    deriving (Show, Eq)
 
 
 -- UTF-8 に encode してから 0x20 - 0x7E の範圍を除いて URI escape する。

diff --git a/Rakka/Storage/DefaultPage.hs b/Rakka/Storage/DefaultPage.hs
index de1e3a1321029aa3dcd19b7a72dd373f53651068..73f4e3307cf4962605b69c66d5fede9a0980d975 100644 (file)
--- a/Rakka/Storage/DefaultPage.hs
+++ b/Rakka/Storage/DefaultPage.hs
@@ -56,7 +56,7 @@ loadDefaultPage :: PageName -> IO (Maybe Page)
 loadDefaultPage name
     -- ./defaultPages が存在するなら、./defaultPages/Foo.xml を探す。無
     -- ければ Cabal で defaultPages/Foo.xml を探す。
-    = do let pagePath = "defaultPages" </> (encodePageName name `addExtension` "xml")
+    = do let pagePath = "defaultPages" </> encodePageName name <.> "xml"
 
          localDirExists <- doesLocalDirExist
          if localDirExists then

diff --git a/Rakka/Storage/Impl.hs b/Rakka/Storage/Impl.hs
index a6d00561498e2e7ca5b74ef2ab5a6ab87485b4b7..20208bf2208a846b9f421d721465276280381e4a 100644 (file)
--- a/Rakka/Storage/Impl.hs
+++ b/Rakka/Storage/Impl.hs
@@ -51,7 +51,9 @@ findAllPages repos rev = do reposPages   <- findAllPagesInRevision repos rev
 findChangedPages :: Repository -> RevNum -> RevNum -> IO (Set PageName)
 findChangedPages repos 0      newRev = findAllPages repos newRev
 findChangedPages repos oldRev newRev
-    = findAllPages repos newRev -- FIXME
+    = mapM (findChangedPagesAtRevision repos) [oldRev + 1 .. newRev]
+      >>=
+      return . S.unions
 
 
 getCurrentRevNum :: Repository -> IO RevNum

diff --git a/Rakka/Storage/Repos.hs b/Rakka/Storage/Repos.hs
index d42fdb90bd3c46ac28bc0aeee9989c528e36fe0b..55117ab1beac7836e2c3f163577647ffd002679c 100644 (file)
--- a/Rakka/Storage/Repos.hs
+++ b/Rakka/Storage/Repos.hs
@@ -1,9 +1,12 @@
 module Rakka.Storage.Repos
     ( findAllPagesInRevision
+    , findChangedPagesAtRevision
     , loadPageInRepository
     )
     where
 
+import           Control.Monad
+import           Data.List
 import qualified Data.Map as M
 import           Data.Maybe
 import           Data.Set (Set)
@@ -54,6 +57,23 @@ findAllPagesInRevision repos rev
       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
@@ -69,7 +89,7 @@ loadPageInRepository repos name rev
                         -> return Nothing
     where
       path :: FilePath
-      path = "pages" </> (encodePageName name `addExtension` "page")
+      path = "pages" </> encodePageName name <.> "page"
 
       loadPage' :: Rev Page
       loadPage' = do redirect <- getNodeProp path "rakka:redirect"