From 602cb8599101da778f6cbb043451cfa458dff89c Mon Sep 17 00:00:00 2001 From: pho Date: Fri, 26 Oct 2007 22:44:50 +0900 Subject: [PATCH] Wrote more darcs-hash:20071026134450-62b54-4b60ba7ea38721949c2f29d3b58a3b6bcaabded6.gz --- Rakka.cabal | 5 ++-- Rakka/Resource/Object.hs | 2 +- Rakka/Resource/Render.hs | 2 +- Rakka/Storage.hs | 49 ++++++++++++++++++++++++++++------------ Rakka/Wiki/Engine.hs | 12 +++++----- defaultPages/Help/Syntax | 2 ++ defaultPages/MainPage | 2 -- 7 files changed, 48 insertions(+), 26 deletions(-) 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"]]]
example
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] -- 2.40.0