X-Git-Url: https://git.cielonegro.org/gitweb.cgi?a=blobdiff_plain;f=Rakka%2FStorage%2FRepos.hs;h=8f49cbe4ad8c512004be6c52574276ef0427172d;hb=43113f26d3e61c96d896724c5509abe67b6a99e7;hp=09bd8f3b40e4f4dce879577a66b60b3c88cf67f3;hpb=4f689140d417db80cfa94e932dcfdbfdd428d8c7;p=Rakka.git

diff --git a/Rakka/Storage/Repos.hs b/Rakka/Storage/Repos.hs
index 09bd8f3..8f49cbe 100644
--- a/Rakka/Storage/Repos.hs
+++ b/Rakka/Storage/Repos.hs
@@ -71,7 +71,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 +104,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 +114,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
@@ -136,23 +136,24 @@ loadPageInRepository repos name rev
          withRevision fs rev'
              $ do exists <- isFile path
                   if exists then
-                      return . Just =<< loadPage'
+                      return . Just =<< loadPage' fs
                     else
                       return Nothing
     where
       path :: FilePath
       path = mkPagePath name
 
-      loadPage' :: Rev Page
-      loadPage' = do mType <- liftM (fmap (read . chomp)) (getNodeProp path "svn:mime-type")
-                     case mType of
-                       Just (MIMEType "application" "x-rakka-redirection" _)
-                           -> loadPageRedirect
-                       _
-                           -> loadPageEntity
-
-      loadPageEntity :: Rev Page
-      loadPageEntity
+      loadPage' :: FileSystem -> Rev Page
+      loadPage' fs
+          = do mType <- liftM (fmap (read . chomp)) (getNodeProp path "svn:mime-type")
+               case mType of
+                 Just (MIMEType "application" "x-rakka-redirection" _)
+                     -> loadPageRedirect fs
+                 _
+                     -> loadPageEntity fs
+
+      loadPageEntity :: FileSystem -> Rev Page
+      loadPageEntity fs
           = do props   <- getNodePropList path
                hist    <- getNodeHistory True path
                content <- getFileContentsLBS path
@@ -162,8 +163,9 @@ loadPageInRepository repos name rev
                               $ fromMaybe "text/x-rakka"
                               $ fmap chomp (lookup "svn:mime-type" props)
 
-               lastMod <- getRevisionProp "svn:date"
-                          >>= return . fromJust . parseW3CDateTime . chomp . fromJust
+               lastMod <- unsafeIOToFS $
+                          liftM (fromJust . parseW3CDateTime . chomp . fromJust)
+                                (getRevisionProp' fs pageRev "svn:date")
 
                return Entity {
                             entityName       = name
@@ -188,19 +190,19 @@ loadPageInRepository repos name rev
                           , entityUpdateInfo = undefined
                           }
       
-      loadPageRedirect :: Rev Page
-      loadPageRedirect
+      loadPageRedirect :: FileSystem -> Rev Page
+      loadPageRedirect fs
           = do hist    <- getNodeHistory True path
                content <- getFileContents path
 
                let pageRev = fst $ head hist
                    dest    = chomp $ decodeString content
 
-               lastMod <- getRevisionProp "svn:date"
-                          >>= return . fromJust . parseW3CDateTime . chomp . fromJust
+               lastMod <- unsafeIOToFS $
+                          liftM (fromJust . parseW3CDateTime . chomp . fromJust)
+                                (getRevisionProp' fs pageRev "svn:date")
 
-               isLocked <- getRevisionProp "rakka:isLocked"
-                           >>= return . isJust
+               isLocked <- liftM isJust (getNodeProp path "rakka:isLocked")
 
                return Redirection {
                             redirName       = name
@@ -239,11 +241,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
@@ -422,7 +424,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 =>
@@ -464,4 +466,4 @@ filterSvnError f = catchDyn f rethrow
           = let code = svnErrCode err
                 msg  = svnErrMsg  err
             in
-              fail $ "SvnError: " ++ (show code) ++ ": " ++ msg
+              fail $ "SvnError: " ++ show code ++ ": " ++ msg