, entityIsTheme = any ((== "rakka:isTheme") . fst) props
, entityIsFeed = any ((== "rakka:isFeed") . fst) props
, entityIsLocked = any ((== "rakka:isLocked") . fst) props
- , entityIsBoring = any ((== "rakka:isBoring") . fst) props
, entityIsBinary = case mimeType of
MIMEType "text" _ _
-> any ((== "rakka:isBinary") . fst) props
(Just "Automatic commit by Rakka for page update")
$ do case uiOldName ui of
Nothing -> return ()
- Just oldName -> renamePage oldName name
+ Just oldName -> renamePage (uiOldRevision ui) oldName name
updatePage name
Nothing
-> do fs <- getRepositoryFS repos
Left _ -> return Conflict
Right _ -> return Created
where
- renamePage :: PageName -> PageName -> Txn ()
- renamePage oldName newName
- = fail "FIXME: renamePage: not implemented yet"
+ renamePage :: RevNum -> PageName -> PageName -> Txn ()
+ renamePage oldRev oldName newName
+ = do let oldPath = mkPagePath oldName
+ newPath = mkPagePath newName
+ createParentDirectories newPath
+ copyEntry oldRev oldPath newPath
+ deleteEntry oldPath
+ deleteEmptyParentDirectories oldPath
createPage :: PageName -> Txn ()
createPage name
createParentDirectories path
makeFile path
- createParentDirectories :: FilePath -> Txn ()
- createParentDirectories path
- = do let parentPath = takeDirectory path
- kind <- checkPath parentPath
- case kind of
- NoNode -> do createParentDirectories parentPath
- makeDirectory parentPath
- FileNode -> fail ("createParentDirectories: already exists a file: " ++ parentPath)
- DirNode -> return ()
-
updatePage :: PageName -> Txn ()
updatePage name
| isRedirect page = updatePageRedirect name
setNodeProp path "rakka:isTheme" Nothing
setNodeProp path "rakka:isFeed" Nothing
setNodeProp path "rakka:isLocked" Nothing
- setNodeProp path "rakka:isBoring" Nothing
setNodeProp path "rakka:isBinary" Nothing
setNodeProp path "rakka:summary" Nothing
setNodeProp path "rakka:otherLang" Nothing
setNodeProp path "rakka:isTheme" (encodeFlag $ entityIsTheme page)
setNodeProp path "rakka:isFeed" (encodeFlag $ entityIsFeed page)
setNodeProp path "rakka:isLocked" (encodeFlag $ entityIsLocked page)
- setNodeProp path "rakka:isBoring" (encodeFlag $ entityIsBoring page)
setNodeProp path "rakka:isBinary" (encodeFlag $ entityIsBinary page)
setNodeProp path "rakka:summary" (entitySummary page)
setNodeProp path "rakka:otherLang" (let otherLang = entityOtherLang page
encodeFlag False = Nothing
+createParentDirectories :: FilePath -> Txn ()
+createParentDirectories path
+ = do let parentPath = takeDirectory path
+ kind <- checkPath parentPath
+ case kind of
+ NoNode -> do createParentDirectories parentPath
+ makeDirectory parentPath
+ FileNode -> fail ("createParentDirectories: already exists a file: " ++ parentPath)
+ DirNode -> return ()
+
+
deletePageFromRepository :: Repository -> PageName -> IO StatusCode
deletePageFromRepository repos name
= filterSvnError $
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
+
+
+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