From: pho <pho@cielonegro.org>
Date: Fri, 26 Oct 2007 13:44:50 +0000 (+0900)
Subject: Wrote more
X-Git-Url: https://git.cielonegro.org/gitweb.cgi?a=commitdiff_plain;h=602cb8599101da778f6cbb043451cfa458dff89c;p=Rakka.git

Wrote more

darcs-hash:20071026134450-62b54-4b60ba7ea38721949c2f29d3b58a3b6bcaabded6.gz
---

diff --git a/Rakka.cabal b/Rakka.cabal
index 6ccfb14..60b1ca8 100644
--- a/Rakka.cabal
+++ b/Rakka.cabal
@@ -21,8 +21,9 @@ Category:
 Tested-With:
     GHC == 6.6.1
 Build-Depends:
-    Crypto, FileManip, HUnit, HsHyperEstraier, HsSVN, Lucu, base,
-    encoding, filepath, hslogger, hxt, mtl, network, parsec, stm, unix
+    Crypto, FileManip, HUnit, HsHyperEstraier >= 0.2, HsSVN, Lucu,
+    base, encoding, filepath, hslogger, hxt, mtl, network, parsec,
+    stm, unix
 Data-Files:
     defaultpages/Help/SampleImage/Large
     defaultpages/Help/SampleImage/Small
diff --git a/Rakka/Resource/Object.hs b/Rakka/Resource/Object.hs
index b029e54..a18a268 100644
--- a/Rakka/Resource/Object.hs
+++ b/Rakka/Resource/Object.hs
@@ -32,7 +32,7 @@ resObject env
 
 handleGet :: Environment -> PageName -> Resource ()
 handleGet env name
-    = do pageM <- getPage (envStorage env) name
+    = do pageM <- getPage (envStorage env) name Nothing
          case pageM of
            Nothing
                -> foundNoEntity Nothing
diff --git a/Rakka/Resource/Render.hs b/Rakka/Resource/Render.hs
index a22d7c4..213b075 100644
--- a/Rakka/Resource/Render.hs
+++ b/Rakka/Resource/Render.hs
@@ -46,7 +46,7 @@ fallbackRender env path
 handleGet :: Environment -> PageName -> Resource ()
 handleGet env name
     = runIdempotentA $ proc ()
-    -> do pageM <- getPageA (envStorage env) -< name
+    -> do pageM <- getPageA (envStorage env) -< (name, Nothing)
           case pageM of
             Nothing
                 -> handlePageNotFound env -< name
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 ()
diff --git a/Rakka/Wiki/Engine.hs b/Rakka/Wiki/Engine.hs
index bb8dc3b..b646a52 100644
--- a/Rakka/Wiki/Engine.hs
+++ b/Rakka/Wiki/Engine.hs
@@ -46,9 +46,9 @@ formatEntirePage sto sysConf interpTable
           BaseURI    baseURI  <- getSysConfA sysConf -< ()
           StyleSheet cssName  <- getSysConfA sysConf -< ()
 
-          Just pageTitle    <- getPageA sto -< "PageTitle"
-          Just leftSideBar  <- getPageA sto -< "SideBar/Left"
-          Just rightSideBar <- getPageA sto -< "SideBar/Right"
+          Just pageTitle    <- getPageA sto -< ("PageTitle"    , Nothing)
+          Just leftSideBar  <- getPageA sto -< ("SideBar/Left" , Nothing)
+          Just rightSideBar <- getPageA sto -< ("SideBar/Right", Nothing)
 
           tree <- ( eelem "/"
                     += ( eelem "page"
@@ -135,9 +135,9 @@ formatUnexistentPage sto sysConf interpTable
           BaseURI    baseURI  <- getSysConfA sysConf -< ()
           StyleSheet cssName  <- getSysConfA sysConf -< ()
 
-          Just pageTitle    <- getPageA sto -< "PageTitle"
-          Just leftSideBar  <- getPageA sto -< "SideBar/Left"
-          Just rightSideBar <- getPageA sto -< "SideBar/Right"
+          Just pageTitle    <- getPageA sto -< ("PageTitle"    , Nothing)
+          Just leftSideBar  <- getPageA sto -< ("SideBar/Left" , Nothing)
+          Just rightSideBar <- getPageA sto -< ("SideBar/Right", Nothing)
 
           tree <- ( eelem "/"
                     += ( eelem "pageNotFound"
diff --git a/defaultPages/Help/Syntax b/defaultPages/Help/Syntax
index ce9a0b2..d60a5a5 100644
--- a/defaultPages/Help/Syntax
+++ b/defaultPages/Help/Syntax
@@ -90,6 +90,8 @@ blah blah blah blah...
 * [[#example]]
 * [http://www.google.com/]
 * [http://www.google.com/ Google]
+* [[[Page]]]
+* [[[Page|Link to object of "Page"]]]
 
 
 <div id="example">example</div>
diff --git a/defaultPages/MainPage b/defaultPages/MainPage
index dde08d7..cdfb7d6 100644
--- a/defaultPages/MainPage
+++ b/defaultPages/MainPage
@@ -23,8 +23,6 @@ Another paragraph...
 
 == Subsection ==
 
-* [[[Help/Syntax]]]
-* [[[Help/Syntax|Object of Help/Syntax]]]
 * [[Help/Syntax]]
 * [http://cielonegro.org/]
 * [http://cielonegro.org/ CieloNegro]