X-Git-Url: http://git.cielonegro.org/gitweb.cgi?a=blobdiff_plain;f=Rakka%2FStorage.hs;h=55037f03712294efac4ec84c9565b0e8aab62882;hb=9681bedbfde02fa1bcda4fbbacba941378c7a57a;hp=1abace0ac17453e210c87b284cb56eda4be73282;hpb=885faf1cabc3f79c90e1885268e2a9138b1ddefb;p=Rakka.git diff --git a/Rakka/Storage.hs b/Rakka/Storage.hs index 1abace0..55037f0 100644 --- a/Rakka/Storage.hs +++ b/Rakka/Storage.hs @@ -8,36 +8,69 @@ module Rakka.Storage , 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 :: Storage -- FIXME -mkStorage = Storage +getPage :: MonadIO m => Storage -> PageName -> Maybe RevNum -> m (Maybe Page) +getPage = ((liftIO .) .) . getPage' . stoRepository -getPage :: MonadIO m => Storage -> PageName -> m (Maybe Page) -getPage sto name - = liftIO $ loadDefaultPage name -- FIXME +putPage :: MonadIO m => Storage -> Page -> RevNum -> m () +putPage sto page oldRev + = error "FIXME: not implemented" -putPage :: MonadIO m => Storage -> Maybe RevNum -> Page -> m () -putPage sto oldRev 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 -getPageA :: ArrowIO a => Storage -> a PageName (Maybe Page) -getPageA = arrIO . getPage +syncIndex :: Storage -> IO () +syncIndex sto + = atomically $ writeTChan (stoIndexChan sto) SyncIndex -putPageA :: ArrowIO a => Storage -> a (Maybe RevNum, Page) () -putPageA = arrIO2 . putPage \ No newline at end of file