Rakka/Storage.hs

   1 module Rakka.Storage
   2     ( Storage
   3
   4     , mkStorage -- private
   5
   6     , getPage
   7     , putPage
   8
   9     , getPageA
  10     , putPageA
  11
  12     , searchPages
  13     )
  14     where
  15
  16 import           Control.Arrow.ArrowIO
  17 import           Control.Concurrent.STM
  18 import           Control.Monad
  19 import           Control.Monad.Trans
  20 import           Data.Maybe
  21 import           Rakka.Page
  22 import           Rakka.Storage.Impl
  23 import           Rakka.Storage.Types
  24 import           Subversion.Types
  25 import           System.IO
  26 import           Subversion.Repository
  27 import           Text.HyperEstraier hiding (WriteLock)
  28
  29 logger = "Rakka.Storage"
  30
  31
  32 mkStorage :: FilePath -> Repository -> (Page -> IO Document) -> IO Storage
  33 mkStorage lsdir repos mkDraft
  34     = do chan <- startIndexManager lsdir repos mkDraft
  35          let sto = Storage {
  36                      stoRepository = repos
  37                    , stoIndexChan  = chan
  38                    }
  39          syncIndex sto
  40          return sto
  41
  42
  43 getPage :: MonadIO m => Storage -> PageName -> Maybe RevNum -> m (Maybe Page)
  44 getPage = ((liftIO .) .) . getPage' . stoRepository
  45
  46
  47 putPage :: MonadIO m => Storage -> Page -> RevNum -> m ()
  48 putPage sto page oldRev
  49     = error "FIXME: not implemented"
  50
  51
  52 getPageA :: ArrowIO a => Storage -> a (PageName, Maybe RevNum) (Maybe Page)
  53 getPageA = arrIO2 . getPage
  54
  55
  56 putPageA :: ArrowIO a => Storage -> a (Page, RevNum) ()
  57 putPageA = arrIO2 . putPage
  58
  59
  60 searchPages :: MonadIO m => Storage -> Condition -> m [(PageName, RevNum)]
  61 searchPages sto cond
  62     = liftIO $
  63       do var <- newEmptyTMVarIO
  64          atomically $ writeTChan (stoIndexChan sto) (SearchIndex cond var)
  65          atomically $ takeTMVar var
  66
  67
  68 syncIndex :: Storage -> IO ()
  69 syncIndex sto
  70     = atomically $ writeTChan (stoIndexChan sto) SyncIndex
  71