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