X-Git-Url: http://git.cielonegro.org/gitweb.cgi?a=blobdiff_plain;f=Rakka%2FStorage.hs;h=56b42da0ae57f8668685f86d1cd9bca08ebe0f60;hb=126e9f3faff19add1fb3dea792ec10dc57c30f03;hp=d830131d962b5c2eeb6fb3f6acc43e113a14650a;hpb=484e15845d9c06d0fa62044d3b6b3ff8c78a6e04;p=Rakka.git diff --git a/Rakka/Storage.hs b/Rakka/Storage.hs index d830131..56b42da 100644 --- a/Rakka/Storage.hs +++ b/Rakka/Storage.hs @@ -4,26 +4,68 @@ module Rakka.Storage , mkStorage -- private , getPage - , savePage + , putPage + + , 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 :: IO Storage -- FIXME -mkStorage = return 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 :: Storage -> PageName -> IO (Maybe Page) -getPage sto name - = loadDefaultPage name -- FIXME +getPage :: MonadIO m => Storage -> PageName -> Maybe RevNum -> m (Maybe Page) +getPage = ((liftIO .) .) . getPage' . stoRepository -savePage :: Storage -> PageName -> Page -> IO () -savePage sto name page +putPage :: MonadIO m => Storage -> Page -> RevNum -> m () +putPage sto page oldRev = 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 + + +syncIndex :: Storage -> IO () +syncIndex sto + = atomically $ writeTChan (stoIndexChan sto) SyncIndex +