X-Git-Url: http://git.cielonegro.org/gitweb.cgi?a=blobdiff_plain;f=Rakka%2FStorage.hs;h=945bfd35ca0282c1940e4727d5fd5677f7b63124;hb=7a4f13a3d483c950743e1ced001ade4406d239d3;hp=d830131d962b5c2eeb6fb3f6acc43e113a14650a;hpb=484e15845d9c06d0fa62044d3b6b3ff8c78a6e04;p=Rakka.git diff --git a/Rakka/Storage.hs b/Rakka/Storage.hs index d830131..945bfd3 100644 --- a/Rakka/Storage.hs +++ b/Rakka/Storage.hs @@ -4,26 +4,73 @@ module Rakka.Storage , mkStorage -- private , getPage - , savePage + , putPage + + , getPageA + , putPageA + + , searchPages + + , rebuildIndex ) where +import Control.Arrow.ArrowIO +import Control.Concurrent.STM +import Control.Monad +import Control.Monad.Trans +import Data.Maybe import Rakka.Page -import Rakka.Storage.DefaultPage +import Rakka.Storage.Impl +import Rakka.Storage.Types +import Subversion.Types +import System.IO +import Subversion.Repository +import Text.HyperEstraier hiding (WriteLock) -data Storage = Storage -- FIXME +mkStorage :: FilePath -> Repository -> (Page -> IO Document) -> IO Storage +mkStorage lsdir repos mkDraft + = do chan <- startIndexManager lsdir repos mkDraft + let sto = Storage { + stoRepository = repos + , stoIndexChan = chan + } + syncIndex sto + return sto -mkStorage :: IO Storage -- FIXME -mkStorage = return Storage +getPage :: MonadIO m => Storage -> PageName -> Maybe RevNum -> m (Maybe Page) +getPage = ((liftIO .) .) . getPage' . stoRepository -getPage :: Storage -> PageName -> IO (Maybe Page) -getPage sto name - = loadDefaultPage name -- FIXME +putPage :: MonadIO m => Storage -> Page -> RevNum -> m () +putPage _sto _page _oldRev + = error "FIXME: not implemented" -savePage :: Storage -> PageName -> Page -> IO () -savePage sto name page - = error "FIXME: not implemented" +getPageA :: ArrowIO a => Storage -> a (PageName, Maybe RevNum) (Maybe Page) +getPageA = arrIO2 . getPage + + +putPageA :: ArrowIO a => Storage -> a (Page, RevNum) () +putPageA = arrIO2 . putPage + + +searchPages :: MonadIO m => Storage -> Condition -> m [(PageName, RevNum)] +searchPages sto cond + = liftIO $ + do var <- newEmptyTMVarIO + atomically $ writeTChan (stoIndexChan sto) (SearchIndex cond var) + atomically $ takeTMVar var + + +rebuildIndex :: MonadIO m => Storage -> m () +rebuildIndex sto + = liftIO $ atomically $ writeTChan (stoIndexChan sto) RebuildIndex + + +syncIndex :: Storage -> IO () +syncIndex sto + = atomically $ writeTChan (stoIndexChan sto) SyncIndex +