X-Git-Url: http://git.cielonegro.org/gitweb.cgi?a=blobdiff_plain;f=Rakka%2FStorage.hs;h=d67380855316e2bd655daf72c7161af8d57ae48d;hb=HEAD;hp=a89a2afa4676d10778762b7bd61c9f97ea8e2959;hpb=443af4d3304139bb2187a0c726327b9c05829810;p=Rakka.git diff --git a/Rakka/Storage.hs b/Rakka/Storage.hs index a89a2af..d673808 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 @@ -19,15 +30,13 @@ module Rakka.Storage import Control.Arrow.ArrowIO 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 import Subversion.Types -import System.IO import Subversion.Repository import Text.HyperEstraier hiding (WriteLock) @@ -73,7 +82,15 @@ deletePageA :: ArrowIO a => Storage -> a (Maybe String, PageName) StatusCode deletePageA = arrIO2 . deletePage -searchPages :: MonadIO m => Storage -> Condition -> m [(PageName, RevNum)] +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 @@ -90,3 +107,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