From: pho Date: Mon, 7 Jan 2008 08:54:35 +0000 (+0900) Subject: implemented page deleting X-Git-Url: https://git.cielonegro.org/gitweb.cgi?a=commitdiff_plain;h=044a917ed3908780479b759ac772e1545616c7fc;p=Rakka.git implemented page deleting darcs-hash:20080107085435-62b54-28aae5fba2378812da9b064f236a7ec87f9bc15c.gz --- diff --git a/Rakka/Resource/PageEntity.hs b/Rakka/Resource/PageEntity.hs index 21d38c9..1ad3ffa 100644 --- a/Rakka/Resource/PageEntity.hs +++ b/Rakka/Resource/PageEntity.hs @@ -38,11 +38,11 @@ fallbackPageEntity env path = return $ Just $ ResourceDef { resUsesNativeThread = False , resIsGreedy = True - , resGet = Just $ handleGet env (toPageName path) + , resGet = Just $ handleGet env (toPageName path) , resHead = Nothing , resPost = Nothing - , resPut = Just $ handlePut env (toPageName path) - , resDelete = Nothing + , resPut = Just $ handlePut env (toPageName path) + , resDelete = Just $ handleDelete env (toPageName path) } where toPageName :: [String] -> PageName @@ -310,3 +310,9 @@ handlePut env name -> do page <- parseXmlizedPage -< (name, tree) status <- putPageA (envStorage env) -< page returnA -< setStatus status + + +handleDelete :: Environment -> PageName -> Resource () +handleDelete env name + = do status <- deletePage (envStorage env) name + setStatus status diff --git a/Rakka/Storage.hs b/Rakka/Storage.hs index 63480de..d88a336 100644 --- a/Rakka/Storage.hs +++ b/Rakka/Storage.hs @@ -5,9 +5,11 @@ module Rakka.Storage , getPage , putPage + , deletePage , getPageA , putPageA + , deletePageA , searchPages @@ -52,6 +54,13 @@ putPage sto page return st +deletePage :: MonadIO m => Storage -> PageName -> m StatusCode +deletePage sto name + = liftIO $ do st <- deletePage' (stoRepository sto) name + syncIndex sto + return st + + getPageA :: ArrowIO a => Storage -> a (PageName, Maybe RevNum) (Maybe Page) getPageA = arrIO2 . getPage @@ -60,6 +69,10 @@ putPageA :: ArrowIO a => Storage -> a Page StatusCode putPageA = arrIO . putPage +deletePageA :: ArrowIO a => Storage -> a PageName StatusCode +deletePageA = arrIO . deletePage + + searchPages :: MonadIO m => Storage -> Condition -> m [(PageName, RevNum)] searchPages sto cond = liftIO $ diff --git a/Rakka/Storage/Impl.hs b/Rakka/Storage/Impl.hs index b1b05e3..2c36f51 100644 --- a/Rakka/Storage/Impl.hs +++ b/Rakka/Storage/Impl.hs @@ -1,6 +1,7 @@ module Rakka.Storage.Impl ( getPage' , putPage' + , deletePage' , startIndexManager ) where @@ -47,6 +48,10 @@ putPage' :: Repository -> Page -> IO StatusCode putPage' = putPageIntoRepository +deletePage' :: Repository -> PageName -> IO StatusCode +deletePage' = deletePageFromRepository + + findAllPages :: Repository -> RevNum -> IO (Set PageName) findAllPages _ 0 = findAllDefaultPages findAllPages repos rev = do reposPages <- findAllPagesInRevision repos rev diff --git a/Rakka/Storage/Repos.hs b/Rakka/Storage/Repos.hs index c9b913c..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 @@ -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 diff --git a/js/editPage.js b/js/editPage.js index a8869fb..959d088 100644 --- a/js/editPage.js +++ b/js/editPage.js @@ -153,7 +153,9 @@ Rakka.displayPageEditor = function (pageName, oldRevision, defaultType, source) = $.INPUT({type: "button", value: "Delete this page"}); $(btnDelete).click(function () { - throw new Error("FIXME: not implemented yet"); + if (window.confirm("Do you really want to delete this page?")) { + Rakka.deletePage(pageName); + } }); var updateTRContent = function () { @@ -440,4 +442,21 @@ Rakka.submitRedirection = function (pageName, oldRevision, givenPageName, destin $area.text("Error: " + req.status + " " + req.statusText); } }); -}; \ No newline at end of file +}; + +Rakka.deletePage = function (pageName) { + var url = Rakka.baseURI + encodeURI(pageName); + $.ajax({ + type : "DELETE", + url : url, + success : function () { + window.location.replace(url); + }, + error : function (req) { + Rakka.hideWaitingMessage(); + + var $area = Rakka.switchScreen(); + $area.text("Error: " + req.status + " " + req.statusText); + } + }); +};