From: pho <pho@cielonegro.org>
Date: Wed, 14 Nov 2007 05:41:29 +0000 (+0900)
Subject: Implemented findChangedPagesAtRevision
X-Git-Url: http://git.cielonegro.org/gitweb.cgi?p=Rakka.git;a=commitdiff_plain;h=f6b697ef834373aab21e3fab64cd3d9f23ae6ab9

Implemented findChangedPagesAtRevision

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

diff --git a/Rakka/Page.hs b/Rakka/Page.hs
index 453ed84..c6469a7 100644
--- 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 de1e3a1..73f4e33 100644
--- 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 a6d0056..20208bf 100644
--- 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 d42fdb9..55117ab 100644
--- 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"