X-Git-Url: http://git.cielonegro.org/gitweb.cgi?a=blobdiff_plain;f=Rakka%2FStorage%2FRepos.hs;h=8664d2480d5b62252b5930e43dbee309a21fe204;hb=a4b849476ee3a204ea91dee8f3fd235b0b33a10a;hp=1c5ef08abca28079845c0802dd34170d1551e624;hpb=9a1da61204cdcf932d8260c87c69bd8fa1992533;p=Rakka.git

diff --git a/Rakka/Storage/Repos.hs b/Rakka/Storage/Repos.hs
index 1c5ef08..8664d24 100644
--- a/Rakka/Storage/Repos.hs
+++ b/Rakka/Storage/Repos.hs
@@ -11,7 +11,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 +24,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
@@ -71,7 +69,7 @@ findAllPagesInRevision repos rev
 
       traverse :: FilePath -> Rev (Set PageName)
       traverse dir
-          = getDirEntries dir >>= mapM (traverse' dir) >>= return . S.unions
+          = liftM S.unions (getDirEntries dir >>= mapM (traverse' dir))
 
       traverse' :: FilePath -> DirEntry -> Rev (Set PageName)
       traverse' dir entry
@@ -104,7 +102,7 @@ getDirContentsInRevision repos dir rev
       path = mkDirPath dir
 
       getDir' :: Rev [PageName]
-      getDir' = getDirEntries path >>= return . map entToName
+      getDir' = liftM (map entToName) (getDirEntries path)
 
       entToName :: DirEntry -> PageName
       entToName = (dir </>) . decodePageName . dropExtension . entName
@@ -114,7 +112,7 @@ findChangedPagesAtRevision :: Repository -> RevNum -> IO (Set PageName)
 findChangedPagesAtRevision repos rev
     = do fs <- getRepositoryFS repos
          withRevision fs rev
-             $ getPathsChanged >>= return . foldl accumulatePages S.empty . map fst
+             $ liftM (foldl accumulatePages S.empty . map fst) getPathsChanged
     where
       accumulatePages :: Set PageName -> FilePath -> Set PageName
       accumulatePages s path
@@ -164,8 +162,8 @@ loadPageInRepository repos name rev
                               $ fmap chomp (lookup "svn:mime-type" props)
 
                lastMod <- unsafeIOToFS $
-                          getRevisionProp' fs pageRev "svn:date"
-                          >>= return . fromJust . parseW3CDateTime . chomp . fromJust
+                          liftM (fromJust . parseW3CDateTime . chomp . fromJust)
+                                (getRevisionProp' fs pageRev "svn:date")
 
                return Entity {
                             entityName       = name
@@ -199,11 +197,10 @@ loadPageInRepository repos name rev
                    dest    = chomp $ decodeString content
 
                lastMod <- unsafeIOToFS $
-                          getRevisionProp' fs pageRev "svn:date"
-                          >>= return . fromJust . parseW3CDateTime . chomp . fromJust
+                          liftM (fromJust . parseW3CDateTime . chomp . fromJust)
+                                (getRevisionProp' fs pageRev "svn:date")
 
-               isLocked <- getNodeProp path "rakka:isLocked"
-                           >>= return . isJust
+               isLocked <- liftM isJust (getNodeProp path "rakka:isLocked")
 
                return Redirection {
                             redirName       = name
@@ -217,8 +214,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
@@ -242,11 +238,11 @@ putPageIntoRepository repos userID page
                                         case uiOldName ui of
                                           Nothing      -> return ()
                                           Just oldName -> do exists <- isFile (mkPagePath oldName)
-                                                             when (exists)
+                                                             when exists
                                                                   $ do movePage (uiOldRevision ui) oldName name
                                                                        moveAttachments (uiOldRevision ui) oldName name
                                         exists <- isFile (mkPagePath name)
-                                        unless (exists)
+                                        unless exists
                                                $ createPage name
                                         updatePage name
                             case ret of
@@ -358,8 +354,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
@@ -425,7 +420,7 @@ loadAttachmentInRepository repos pName aName rev
       path = mkAttachmentPath pName aName
 
       loadAttachment' :: Rev a
-      loadAttachment' = getFileContents path >>= return . deserializeFromString . decodeString
+      loadAttachment' = liftM (deserializeFromString . decodeString) (getFileContents path)
 
 
 putAttachmentIntoRepository :: Attachment a =>
@@ -437,8 +432,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
@@ -457,14 +451,3 @@ putAttachmentIntoRepository repos userID oldRev pName aName 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