X-Git-Url: http://git.cielonegro.org/gitweb.cgi?a=blobdiff_plain;f=Rakka%2FStorage%2FRepos.hs;h=576e5b740d5210af8db52ddaf1d845031d661d83;hb=044a917ed3908780479b759ac772e1545616c7fc;hp=f8ac5ddcea7e9a3c587a5477a5c2c6762b936487;hpb=bb9575473ed1064965f9c0322f14991ef62fe523;p=Rakka.git

diff --git a/Rakka/Storage/Repos.hs b/Rakka/Storage/Repos.hs
index f8ac5dd..576e5b7 100644
--- a/Rakka/Storage/Repos.hs
+++ b/Rakka/Storage/Repos.hs
@@ -3,6 +3,7 @@ module Rakka.Storage.Repos
     , findChangedPagesAtRevision
     , loadPageInRepository
     , putPageIntoRepository
+    , deletePageFromRepository
     )
     where
 
@@ -127,7 +128,6 @@ loadPageInRepository repos name rev
                             entityName       = name
                           , entityType       = mimeType
                           , entityLanguage   = fmap chomp (lookup "rakka:lang" props)
-                          , entityFileName   = fmap chomp (lookup "rakka:fileName" props)
                           , entityIsTheme    = any ((== "rakka:isTheme") . fst) props
                           , entityIsFeed     = any ((== "rakka:isFeed") . fst) props
                           , entityIsLocked   = any ((== "rakka:isLocked") . fst) props
@@ -187,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
@@ -227,7 +227,6 @@ putPageIntoRepository repos page
           = do let path = mkPagePath name
                setNodeProp path "svn:mime-type"   (Just "application/x-rakka-redirection")
                setNodeProp path "rakka:lang"      Nothing
-               setNodeProp path "rakka:fileName"  Nothing
                setNodeProp path "rakka:isTheme"   Nothing
                setNodeProp path "rakka:isFeed"    Nothing
                setNodeProp path "rakka:isLocked"  Nothing
@@ -242,7 +241,6 @@ putPageIntoRepository repos page
           = do let path = mkPagePath name
                setNodeProp path "svn:mime-type"   ((Just . show . entityType) page)
                setNodeProp path "rakka:lang"      (entityLanguage page)
-               setNodeProp path "rakka:fileName"  (entityFileName page)
                setNodeProp path "rakka:isTheme"   (encodeFlag $ entityIsTheme page)
                setNodeProp path "rakka:isFeed"    (encodeFlag $ entityIsFeed page)
                setNodeProp path "rakka:isLocked"  (encodeFlag $ entityIsLocked page)
@@ -262,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