Rakka/Storage.hs

   1 module Rakka.Storage
   2     ( Storage
   3
   4     , mkStorage -- private
   5
   6     , getPage
   7     , putPage
   8     , deletePage
   9
  10     , getPageA
  11     , putPageA
  12     , deletePageA
  13
  14     , searchPages
  15
  16     , rebuildIndex
  17     )
  18     where
  19
  20 import           Control.Arrow.ArrowIO
  21 import           Control.Concurrent.STM
  22 import           Control.Monad
  23 import           Control.Monad.Trans
  24 import           Data.Maybe
  25 import           Network.HTTP.Lucu
  26 import           Rakka.Page
  27 import           Rakka.Storage.Impl
  28 import           Rakka.Storage.Types
  29 import           Subversion.Types
  30 import           System.IO
  31 import           Subversion.Repository
  32 import           Text.HyperEstraier hiding (WriteLock)
  33
  34
  35 mkStorage :: FilePath -> Repository -> (Page -> IO Document) -> IO Storage
  36 mkStorage lsdir repos mkDraft
  37     = do chan <- startIndexManager lsdir repos mkDraft
  38          let sto = Storage {
  39                      stoRepository = repos
  40                    , stoIndexChan  = chan
  41                    }
  42          syncIndex sto
  43          return sto
  44
  45
  46 getPage :: MonadIO m => Storage -> PageName -> Maybe RevNum -> m (Maybe Page)
  47 getPage = ((liftIO .) .) . getPage' . stoRepository
  48
  49
  50 putPage :: MonadIO m => Storage -> Page -> m StatusCode
  51 putPage sto page
  52     = liftIO $ do st <- putPage' (stoRepository sto) page
  53                   syncIndex sto
  54                   return st
  55
  56
  57 deletePage :: MonadIO m => Storage -> PageName -> m StatusCode
  58 deletePage sto name
  59     = liftIO $ do st <- deletePage' (stoRepository sto) name
  60                   syncIndex sto
  61                   return st
  62
  63
  64 getPageA :: ArrowIO a => Storage -> a (PageName, Maybe RevNum) (Maybe Page)
  65 getPageA = arrIO2 . getPage
  66
  67
  68 putPageA :: ArrowIO a => Storage -> a Page StatusCode
  69 putPageA = arrIO . putPage
  70
  71
  72 deletePageA :: ArrowIO a => Storage -> a PageName StatusCode
  73 deletePageA = arrIO . deletePage
  74
  75
  76 searchPages :: MonadIO m => Storage -> Condition -> m [(PageName, RevNum)]
  77 searchPages sto cond
  78     = liftIO $
  79       do var <- newEmptyTMVarIO
  80          atomically $ writeTChan (stoIndexChan sto) (SearchIndex cond var)
  81          atomically $ takeTMVar var
  82
  83
  84 rebuildIndex :: MonadIO m => Storage -> m ()
  85 rebuildIndex sto
  86     = liftIO $ atomically $ writeTChan (stoIndexChan sto) RebuildIndex
  87
  88
  89 syncIndex :: Storage -> IO ()
  90 syncIndex sto
  91     = atomically $ writeTChan (stoIndexChan sto) SyncIndex
  92