implemented page deleting

[Rakka.git] / Rakka / Storage / Repos.hs

diff --git a/Rakka/Storage/Repos.hs b/Rakka/Storage/Repos.hs
index c9b913cb303844c1a7ee3ffa78896078120fd28d..576e5b740d5210af8db52ddaf1d845031d661d83 100644 (file)
--- a/Rakka/Storage/Repos.hs
+++ b/Rakka/Storage/Repos.hs
@@ -3,6 +3,7 @@ module Rakka.Storage.Repos
     , findChangedPagesAtRevision
     , loadPageInRepository
     , putPageIntoRepository
+    , deletePageFromRepository
     )
     where
 
@@ -186,11 +187,11 @@ putPageIntoRepository repos page
                       -> do fs  <- getRepositoryFS repos
                             rev <- getYoungestRev fs
                             doReposTxn repos
-                                         rev
-                                         "[Rakka]"
-                                         (Just "Automatic commit by Rakka for page creation")
-                                         $ do createPage name
-                                              updatePage name
+                                       rev
+                                       "[Rakka]"
+                                       (Just "Automatic commit by Rakka for page creation")
+                                       $ do createPage name
+                                            updatePage name
          case ret of
            Left  _ -> return Conflict
            Right _ -> return Created
@@ -259,6 +260,33 @@ putPageIntoRepository repos page
       encodeFlag False = Nothing
 
 
+deletePageFromRepository :: Repository -> PageName -> IO StatusCode
+deletePageFromRepository repos name
+    = filterSvnError $
+      do let path = mkPagePath name
+         fs     <- getRepositoryFS repos
+         rev    <- getYoungestRev fs
+         exists <- withRevision fs rev $ isFile path
+         if exists then
+             do doReposTxn repos
+                           rev
+                           "[Rakka]"
+                           (Just "Automatic commit by Rakka for page deleting")
+                           $ do deleteEntry path
+                                deleteEmptyParentDirectories path
+                return NoContent
+           else
+             return NotFound
+    where
+      deleteEmptyParentDirectories :: FilePath -> Txn ()
+      deleteEmptyParentDirectories path
+          = do let parentPath = takeDirectory path
+               contents <- getDirEntries parentPath
+               when (null contents)
+                        $ do deleteEntry parentPath
+                             deleteEmptyParentDirectories parentPath
+
+
 filterSvnError :: IO a -> IO a
 filterSvnError f = catchDyn f rethrow
     where