Rakka/Storage.hs

   1 module Rakka.Storage
   2     ( Storage
   3
   4     -- re-export from Rakka.Storage.Types
   5     , SearchResult(..)
   6     , HitPage(..)
   7     , SnippetFragment(..)
   8
   9     , mkStorage -- private
  10
  11     , getPage
  12     , putPage
  13     , deletePage
  14
  15     , getPageA
  16     , putPageA
  17     , deletePageA
  18
  19     , getAttachment
  20     , putAttachment
  21
  22     , getDirContents
  23     , getDirContentsA
  24
  25     , searchPages
  26
  27     , rebuildIndex
  28     )
  29     where
  30
  31 import           Control.Arrow.ArrowIO
  32 import           Control.Concurrent.STM
  33 import           Control.Monad.Trans
  34 import           Network.HTTP.Lucu
  35 import           Rakka.Attachment
  36 import           Rakka.Page
  37 import           Rakka.Storage.Impl
  38 import           Rakka.Storage.Types
  39 import           Subversion.Types
  40 import           Subversion.Repository
  41 import           Text.HyperEstraier hiding (WriteLock)
  42
  43
  44 mkStorage :: FilePath -> Repository -> (Page -> IO Document) -> IO Storage
  45 mkStorage lsdir repos mkDraft
  46     = do chan <- startIndexManager lsdir repos mkDraft
  47          let sto = Storage {
  48                      stoRepository = repos
  49                    , stoIndexChan  = chan
  50                    }
  51          syncIndex sto
  52          return sto
  53
  54
  55 getPage :: MonadIO m => Storage -> PageName -> Maybe RevNum -> m (Maybe Page)
  56 getPage = ((liftIO .) .) . getPage' . stoRepository
  57
  58
  59 putPage :: MonadIO m => Storage -> Maybe String -> Page -> m StatusCode
  60 putPage sto userID page
  61     = liftIO $ do st <- putPage' (stoRepository sto) userID page
  62                   syncIndex sto
  63                   return st
  64
  65
  66 deletePage :: MonadIO m => Storage -> Maybe String -> PageName -> m StatusCode
  67 deletePage sto userID name
  68     = liftIO $ do st <- deletePage' (stoRepository sto) userID name
  69                   syncIndex sto
  70                   return st
  71
  72
  73 getPageA :: ArrowIO a => Storage -> a (PageName, Maybe RevNum) (Maybe Page)
  74 getPageA = arrIO2 . getPage
  75
  76
  77 putPageA :: ArrowIO a => Storage -> a (Maybe String, Page) StatusCode
  78 putPageA = arrIO2 . putPage
  79
  80
  81 deletePageA :: ArrowIO a => Storage -> a (Maybe String, PageName) StatusCode
  82 deletePageA = arrIO2 . deletePage
  83
  84
  85 getDirContents :: MonadIO m => Storage -> PageName -> Maybe RevNum -> m [PageName]
  86 getDirContents = ((liftIO .) .) . getDirContents' . stoRepository
  87
  88
  89 getDirContentsA :: ArrowIO a => Storage -> a (PageName, Maybe RevNum) [PageName]
  90 getDirContentsA = arrIO2 . getDirContents
  91
  92
  93 searchPages :: MonadIO m => Storage -> Condition -> m SearchResult
  94 searchPages sto cond
  95     = liftIO $
  96       do var <- newEmptyTMVarIO
  97          atomically $ writeTChan (stoIndexChan sto) (SearchIndex cond var)
  98          atomically $ takeTMVar var
  99
 100
 101 rebuildIndex :: MonadIO m => Storage -> m ()
 102 rebuildIndex sto
 103     = liftIO $ atomically $ writeTChan (stoIndexChan sto) RebuildIndex
 104
 105
 106 syncIndex :: Storage -> IO ()
 107 syncIndex sto
 108     = atomically $ writeTChan (stoIndexChan sto) SyncIndex
 109
 110
 111 getAttachment :: (Attachment a, MonadIO m) =>
 112                  Storage
 113               -> PageName
 114               -> String
 115               -> Maybe RevNum
 116               -> m (Maybe a)
 117 getAttachment = (((liftIO .) .) .) . getAttachment' . stoRepository
 118
 119
 120 putAttachment :: (Attachment a, MonadIO m) =>
 121                  Storage
 122               -> Maybe String
 123               -> Maybe RevNum
 124               -> PageName
 125               -> String
 126               -> a
 127               -> m StatusCode
 128 putAttachment = (((((liftIO .) .) .) .) .) . putAttachment' . stoRepository