X-Git-Url: https://git.cielonegro.org/gitweb.cgi?a=blobdiff_plain;f=Rakka%2FStorage.hs;h=73bc73499b762fdcc3ed1b56f407562e5831c8c7;hb=5ab256be8bbbb1f4a012b41ac1cc3f9b29aa7d57;hp=d88a336506a23dd162278ec8b69930ab18a46879;hpb=044a917ed3908780479b759ac772e1545616c7fc;p=Rakka.git diff --git a/Rakka/Storage.hs b/Rakka/Storage.hs index d88a336..73bc734 100644 --- a/Rakka/Storage.hs +++ b/Rakka/Storage.hs @@ -1,6 +1,11 @@ module Rakka.Storage ( Storage + -- re-export from Rakka.Storage.Types + , SearchResult(..) + , HitPage(..) + , SnippetFragment(..) + , mkStorage -- private , getPage @@ -11,6 +16,12 @@ module Rakka.Storage , putPageA , deletePageA + , getAttachment + , putAttachment + + , getDirContents + , getDirContentsA + , searchPages , rebuildIndex @@ -23,6 +34,7 @@ import Control.Monad import Control.Monad.Trans import Data.Maybe import Network.HTTP.Lucu +import Rakka.Attachment import Rakka.Page import Rakka.Storage.Impl import Rakka.Storage.Types @@ -47,16 +59,16 @@ getPage :: MonadIO m => Storage -> PageName -> Maybe RevNum -> m (Maybe Page) getPage = ((liftIO .) .) . getPage' . stoRepository -putPage :: MonadIO m => Storage -> Page -> m StatusCode -putPage sto page - = liftIO $ do st <- putPage' (stoRepository sto) page +putPage :: MonadIO m => Storage -> Maybe String -> Page -> m StatusCode +putPage sto userID page + = liftIO $ do st <- putPage' (stoRepository sto) userID page syncIndex sto return st -deletePage :: MonadIO m => Storage -> PageName -> m StatusCode -deletePage sto name - = liftIO $ do st <- deletePage' (stoRepository sto) name +deletePage :: MonadIO m => Storage -> Maybe String -> PageName -> m StatusCode +deletePage sto userID name + = liftIO $ do st <- deletePage' (stoRepository sto) userID name syncIndex sto return st @@ -65,15 +77,23 @@ getPageA :: ArrowIO a => Storage -> a (PageName, Maybe RevNum) (Maybe Page) getPageA = arrIO2 . getPage -putPageA :: ArrowIO a => Storage -> a Page StatusCode -putPageA = arrIO . putPage +putPageA :: ArrowIO a => Storage -> a (Maybe String, Page) StatusCode +putPageA = arrIO2 . putPage + +deletePageA :: ArrowIO a => Storage -> a (Maybe String, PageName) StatusCode +deletePageA = arrIO2 . deletePage -deletePageA :: ArrowIO a => Storage -> a PageName StatusCode -deletePageA = arrIO . deletePage +getDirContents :: MonadIO m => Storage -> PageName -> Maybe RevNum -> m [PageName] +getDirContents = ((liftIO .) .) . getDirContents' . stoRepository -searchPages :: MonadIO m => Storage -> Condition -> m [(PageName, RevNum)] + +getDirContentsA :: ArrowIO a => Storage -> a (PageName, Maybe RevNum) [PageName] +getDirContentsA = arrIO2 . getDirContents + + +searchPages :: MonadIO m => Storage -> Condition -> m SearchResult searchPages sto cond = liftIO $ do var <- newEmptyTMVarIO @@ -90,3 +110,22 @@ syncIndex :: Storage -> IO () syncIndex sto = atomically $ writeTChan (stoIndexChan sto) SyncIndex + +getAttachment :: (Attachment a, MonadIO m) => + Storage + -> PageName + -> String + -> Maybe RevNum + -> m (Maybe a) +getAttachment = (((liftIO .) .) .) . getAttachment' . stoRepository + + +putAttachment :: (Attachment a, MonadIO m) => + Storage + -> Maybe String + -> Maybe RevNum + -> PageName + -> String + -> a + -> m StatusCode +putAttachment = (((((liftIO .) .) .) .) .) . putAttachment' . stoRepository