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