26 import Control.Arrow.ArrowIO
27 import Control.Concurrent.STM
29 import Control.Monad.Trans
31 import Network.HTTP.Lucu
32 import Rakka.Attachment
34 import Rakka.Storage.Impl
35 import Rakka.Storage.Types
36 import Subversion.Types
38 import Subversion.Repository
39 import Text.HyperEstraier hiding (WriteLock)
42 mkStorage :: FilePath -> Repository -> (Page -> IO Document) -> IO Storage
43 mkStorage lsdir repos mkDraft
44 = do chan <- startIndexManager lsdir repos mkDraft
53 getPage :: MonadIO m => Storage -> PageName -> Maybe RevNum -> m (Maybe Page)
54 getPage = ((liftIO .) .) . getPage' . stoRepository
57 putPage :: MonadIO m => Storage -> Maybe String -> Page -> m StatusCode
58 putPage sto userID page
59 = liftIO $ do st <- putPage' (stoRepository sto) userID page
64 deletePage :: MonadIO m => Storage -> Maybe String -> PageName -> m StatusCode
65 deletePage sto userID name
66 = liftIO $ do st <- deletePage' (stoRepository sto) userID name
71 getPageA :: ArrowIO a => Storage -> a (PageName, Maybe RevNum) (Maybe Page)
72 getPageA = arrIO2 . getPage
75 putPageA :: ArrowIO a => Storage -> a (Maybe String, Page) StatusCode
76 putPageA = arrIO2 . putPage
79 deletePageA :: ArrowIO a => Storage -> a (Maybe String, PageName) StatusCode
80 deletePageA = arrIO2 . deletePage
83 getDirContents :: MonadIO m => Storage -> PageName -> Maybe RevNum -> m [PageName]
84 getDirContents = ((liftIO .) .) . getDirContents' . stoRepository
87 getDirContentsA :: ArrowIO a => Storage -> a (PageName, Maybe RevNum) [PageName]
88 getDirContentsA = arrIO2 . getDirContents
91 searchPages :: MonadIO m => Storage -> Condition -> m [(PageName, RevNum)]
94 do var <- newEmptyTMVarIO
95 atomically $ writeTChan (stoIndexChan sto) (SearchIndex cond var)
96 atomically $ takeTMVar var
99 rebuildIndex :: MonadIO m => Storage -> m ()
101 = liftIO $ atomically $ writeTChan (stoIndexChan sto) RebuildIndex
104 syncIndex :: Storage -> IO ()
106 = atomically $ writeTChan (stoIndexChan sto) SyncIndex
109 getAttachment :: (Attachment a, MonadIO m) =>
115 getAttachment = (((liftIO .) .) .) . getAttachment' . stoRepository
118 putAttachment :: (Attachment a, MonadIO m) =>
126 putAttachment = (((((liftIO .) .) .) .) .) . putAttachment' . stoRepository