X-Git-Url: http://git.cielonegro.org/gitweb.cgi?a=blobdiff_plain;f=Rakka%2FStorage.hs;h=56b42da0ae57f8668685f86d1cd9bca08ebe0f60;hb=126e9f3faff19add1fb3dea792ec10dc57c30f03;hp=1abace0ac17453e210c87b284cb56eda4be73282;hpb=885faf1cabc3f79c90e1885268e2a9138b1ddefb;p=Rakka.git diff --git a/Rakka/Storage.hs b/Rakka/Storage.hs index 1abace0..56b42da 100644 --- a/Rakka/Storage.hs +++ b/Rakka/Storage.hs @@ -8,36 +8,64 @@ module Rakka.Storage , getPageA , putPageA + + , searchPages ) 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 +logger = "Rakka.Storage" -mkStorage :: Storage -- FIXME -mkStorage = Storage +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 -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 +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 (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 + +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