X-Git-Url: http://git.cielonegro.org/gitweb.cgi?a=blobdiff_plain;ds=sidebyside;f=Rakka%2FStorage.hs;h=73bc73499b762fdcc3ed1b56f407562e5831c8c7;hb=b33b02e8fdc8e24c0a5062e122212122e8031523;hp=55037f03712294efac4ec84c9565b0e8aab62882;hpb=9681bedbfde02fa1bcda4fbbacba941378c7a57a;p=Rakka.git diff --git a/Rakka/Storage.hs b/Rakka/Storage.hs index 55037f0..73bc734 100644 --- a/Rakka/Storage.hs +++ b/Rakka/Storage.hs @@ -1,13 +1,26 @@ module Rakka.Storage ( Storage + -- re-export from Rakka.Storage.Types + , SearchResult(..) + , HitPage(..) + , SnippetFragment(..) + , mkStorage -- private , getPage , putPage + , deletePage , getPageA , putPageA + , deletePageA + + , getAttachment + , putAttachment + + , getDirContents + , getDirContentsA , searchPages @@ -20,6 +33,8 @@ import Control.Concurrent.STM 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 @@ -44,20 +59,41 @@ getPage :: MonadIO m => Storage -> PageName -> Maybe RevNum -> m (Maybe Page) getPage = ((liftIO .) .) . getPage' . stoRepository -putPage :: MonadIO m => Storage -> Page -> RevNum -> m () -putPage sto page oldRev - = error "FIXME: not implemented" +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 -> Maybe String -> PageName -> m StatusCode +deletePage sto userID name + = liftIO $ do st <- deletePage' (stoRepository sto) userID name + syncIndex sto + return st getPageA :: ArrowIO a => Storage -> a (PageName, Maybe RevNum) (Maybe Page) getPageA = arrIO2 . getPage -putPageA :: ArrowIO a => Storage -> a (Page, RevNum) () +putPageA :: ArrowIO a => Storage -> a (Maybe String, Page) StatusCode putPageA = arrIO2 . putPage -searchPages :: MonadIO m => Storage -> Condition -> m [(PageName, RevNum)] +deletePageA :: ArrowIO a => Storage -> a (Maybe String, PageName) StatusCode +deletePageA = arrIO2 . deletePage + + +getDirContents :: MonadIO m => Storage -> PageName -> Maybe RevNum -> m [PageName] +getDirContents = ((liftIO .) .) . getDirContents' . stoRepository + + +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 @@ -74,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