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
  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 rebuildIndex :: MonadIO m => Storage -> m ()
  69 rebuildIndex sto
  70     = liftIO $ atomically $ writeTChan (stoIndexChan sto) RebuildIndex
  71
  72
  73 syncIndex :: Storage -> IO ()
  74 syncIndex sto
  75     = atomically $ writeTChan (stoIndexChan sto) SyncIndex
  76