X-Git-Url: http://git.cielonegro.org/gitweb.cgi?a=blobdiff_plain;f=Rakka%2FStorage%2FRepos.hs;h=a6977e67286e2b35d81ce71e710018616f926fc2;hb=fcddebcc3cc02ae8d1904b9338334d538019e74a;hp=8f49cbe4ad8c512004be6c52574276ef0427172d;hpb=43113f26d3e61c96d896724c5509abe67b6a99e7;p=Rakka.git diff --git a/Rakka/Storage/Repos.hs b/Rakka/Storage/Repos.hs index 8f49cbe..a6977e6 100644 --- a/Rakka/Storage/Repos.hs +++ b/Rakka/Storage/Repos.hs @@ -1,3 +1,4 @@ +-- -*- coding: utf-8 -*- module Rakka.Storage.Repos ( findAllPagesInRevision , getDirContentsInRevision @@ -11,7 +12,6 @@ module Rakka.Storage.Repos where import Codec.Binary.UTF8.String -import Control.Exception import Control.Monad import Data.List import qualified Data.Map as M @@ -25,7 +25,6 @@ import Rakka.Page import Rakka.SystemConfig import Rakka.Utils import Rakka.W3CDateTime -import Subversion.Error import Subversion.FileSystem import Subversion.FileSystem.DirEntry import Subversion.FileSystem.Revision @@ -216,8 +215,7 @@ loadPageInRepository repos name rev putPageIntoRepository :: Repository -> Maybe String -> Page -> IO StatusCode putPageIntoRepository repos userID page - = filterSvnError $ - do let name = pageName page + = do let name = pageName page author = fromMaybe "[Rakka]" userID case pageUpdateInfo page of Just ui @@ -357,8 +355,7 @@ createParentDirectories path deletePageFromRepository :: Repository -> Maybe String -> PageName -> IO StatusCode deletePageFromRepository repos userID name - = filterSvnError $ - do let pagePath = mkPagePath name + = do let pagePath = mkPagePath name attachmentPath = mkAttachmentDirPath name fs <- getRepositoryFS repos rev <- getYoungestRev fs @@ -378,7 +375,7 @@ deletePageFromRepository repos userID name else return NotFound when (status == NoContent) - $ do doReposTxn repos + $ ( (doReposTxn repos rev "[Rakka]" (Just "Automatic commit by Rakka for page deleting") @@ -388,8 +385,8 @@ deletePageFromRepository repos userID name attachmentExists <- isDirectory attachmentPath when attachmentExists $ do deleteEntry attachmentPath - deleteEmptyParentDirectories attachmentPath - return () + deleteEmptyParentDirectories attachmentPath) + >> return () ) return status @@ -436,8 +433,7 @@ putAttachmentIntoRepository :: Attachment a => -> a -> IO StatusCode putAttachmentIntoRepository repos userID oldRev pName aName attachment - = filterSvnError $ - do let author = fromMaybe "[Rakka]" userID + = do let author = fromMaybe "[Rakka]" userID path = mkAttachmentPath pName aName fs <- getRepositoryFS repos oldRev' <- case oldRev of @@ -452,18 +448,7 @@ putAttachmentIntoRepository repos userID oldRev pName aName attachment unless exists $ do createParentDirectories path makeFile path - applyText path Nothing (serializeToString attachment) + applyText path Nothing (encodeString $ serializeToString attachment) case ret of Left _ -> return Conflict Right _ -> return NoContent - - -filterSvnError :: IO a -> IO a -filterSvnError f = catchDyn f rethrow - where - rethrow :: SvnError -> IO a - rethrow err - = let code = svnErrCode err - msg = svnErrMsg err - in - fail $ "SvnError: " ++ show code ++ ": " ++ msg