X-Git-Url: http://git.cielonegro.org/gitweb.cgi?p=Rakka.git;a=blobdiff_plain;f=Rakka%2FStorage.hs;h=6b0e098e883eedad9908154edea5205308912e38;hp=83bb07795c2a5230230403d4df910663af51975d;hb=602cb8599101da778f6cbb043451cfa458dff89c;hpb=ddf0b4d7ab2f1e141edbc7ef75d39853c0846f8c

diff --git a/Rakka/Storage.hs b/Rakka/Storage.hs
index 83bb077..6b0e098 100644
--- a/Rakka/Storage.hs
+++ b/Rakka/Storage.hs
@@ -17,6 +17,7 @@ import           Control.Exception
 import           Control.Monad
 import           Control.Monad.Trans
 import           Data.Set (Set)
+import qualified Data.Set as S
 import           Rakka.Page
 import           Rakka.Storage.DefaultPage
 import           Subversion.Types
@@ -64,33 +65,38 @@ mkStorage lsdir repos mkDraft
          return sto
 
 
-getPage :: MonadIO m => Storage -> PageName -> m (Maybe Page)
-getPage sto name
-    = liftIO $ loadDefaultPage name -- FIXME
+getPage :: MonadIO m => Storage -> PageName -> Maybe RevNum -> m (Maybe Page)
+getPage = ((liftIO .) .) . getPage' . stoRepository
 
 
-putPage :: MonadIO m => Storage -> Maybe RevNum -> Page -> m ()
-putPage sto oldRev page
+getPage' :: Repository -> PageName -> Maybe RevNum -> IO (Maybe Page)
+getPage' repos name rev
+    = loadDefaultPage name -- FIXME
+
+
+putPage :: MonadIO m => Storage -> Page -> RevNum -> m ()
+putPage sto page oldRev
     = error "FIXME: not implemented"
 
 
-getPageA :: ArrowIO a => Storage -> a PageName (Maybe Page)
-getPageA = arrIO . getPage 
+getPageA :: ArrowIO a => Storage -> a (PageName, Maybe RevNum) (Maybe Page)
+getPageA = arrIO2 . getPage 
 
 
-putPageA :: ArrowIO a => Storage -> a (Maybe RevNum, Page) ()
+putPageA :: ArrowIO a => Storage -> a (Page, RevNum) ()
 putPageA = arrIO2 . putPage
 
 
 findAllPages :: Storage -> RevNum -> IO (Set PageName)
-findAllPages sto revNum
+findAllPages _   0   = findAllDefaultPages
+findAllPages sto rev
     = findAllDefaultPages -- FIXME
 
 
 findChangedPages :: Storage -> RevNum -> RevNum -> IO (Set PageName)
 findChangedPages sto 0      newRev = findAllPages sto newRev
 findChangedPages sto oldRev newRev
-    = fail "fixme: not impl"
+    = fail "FIXME: not impl"
 
 
 getCurrentRevNum :: Storage -> IO RevNum
@@ -135,14 +141,29 @@ syncIndex sto
          debugM logger ("The repository revision is currently " ++ show newRev)
 
          when (newRev /= oldRev) (syncIndex' oldRev newRev)
-
-         return oldRev -- FIXME
-         --return newRev
+         return newRev
     where
       syncIndex' :: RevNum -> RevNum -> IO ()
       syncIndex' oldRev newRev
           = do pages <- findChangedPages sto oldRev newRev
-               print pages -- FIXME
+               mapM_ (updateIndex sto newRev) (S.toList pages)
+
+
+updateIndex :: Storage -> RevNum -> PageName -> IO ()
+updateIndex sto rev name
+    = do pageM <- getPage sto name (Just rev)
+         case pageM of
+           -- ページが削除された
+           Nothing
+               -> do docIdM <- getDocIdByURI (stoIndexDB sto) (mkRakkaURI name)
+                     case docIdM of
+                       Nothing    -> return ()
+                       Just docId -> do removeDocument (stoIndexDB sto) docId [CleaningRemove]
+                                        infoM logger ("Removed page " ++ name ++ " from the index")
+           Just page
+               -> do draft <- stoMakeDraft sto page
+                     putDocument (stoIndexDB sto) draft [CleaningPut]
+                     infoM logger ("Indexed page " ++ name ++ " of revision " ++ show (pageRevision page))
 
 
 updateIndexRev :: Storage -> (RevNum -> IO RevNum) -> IO ()