From 743f4a87fd557832ce67d6eb51749582820577c4 Mon Sep 17 00:00:00 2001 From: pho Date: Sun, 16 Dec 2007 15:26:52 +0900 Subject: [PATCH] we can now create new pages darcs-hash:20071216062652-62b54-61857b2af474cb50fc497e41d96b630cd838523e.gz --- Rakka/Storage/Repos.hs | 72 +++++++++++++++++++++------------- Rakka/Wiki/Interpreter/Base.hs | 25 ++++++++++++ defaultPages/SideBar/Right.xml | 1 + js/editPage.js | 6 ++- schemas/rakka-page-1.0.rng | 28 +++++++------ 5 files changed, 92 insertions(+), 40 deletions(-) diff --git a/Rakka/Storage/Repos.hs b/Rakka/Storage/Repos.hs index 81ab876..0b53568 100644 --- a/Rakka/Storage/Repos.hs +++ b/Rakka/Storage/Repos.hs @@ -6,6 +6,7 @@ module Rakka.Storage.Repos ) where +import Control.Exception import Control.Monad import Data.List import qualified Data.Map as M @@ -18,19 +19,20 @@ import Rakka.Page import Rakka.SystemConfig import Rakka.Utils import Rakka.W3CDateTime -import Subversion.Types +import Subversion.Error import Subversion.FileSystem import Subversion.FileSystem.DirEntry import Subversion.FileSystem.Revision import Subversion.FileSystem.Root import Subversion.FileSystem.Transaction import Subversion.Repository +import Subversion.Types import System.FilePath.Posix mkPagePath :: PageName -> FilePath mkPagePath name - = "pages" encodePageName name <.> "page" + = "/pages" encodePageName name <.> "page" findAllPagesInRevision :: Repository -> RevNum -> IO (Set PageName) @@ -151,44 +153,49 @@ loadPageInRepository repos name rev putPageIntoRepository :: Repository -> Page -> IO StatusCode putPageIntoRepository repos page - = do let Just ui = pageUpdateInfo page - name = pageName page - ret <- doReposTxn - repos - (uiOldRevision ui) - "[Rakka]" - (Just "Automatic commit by Rakka for page updating") - $ do case uiOldName ui of - Nothing -> return () - Just oldName -> renamePage oldName name - createPageIfNeeded name - updatePage name + = filterSvnError $ + do let name = pageName page + ret <- case pageUpdateInfo page of + Just ui + -> doReposTxn + repos + (uiOldRevision ui) + "[Rakka]" + (Just "Automatic commit by Rakka for page update") + $ do case uiOldName ui of + Nothing -> return () + Just oldName -> renamePage oldName name + updatePage name + Nothing + -> do fs <- getRepositoryFS repos + rev <- getYoungestRev fs + doReposTxn repos + rev + "[Rakka]" + (Just "Automatic commit by Rakka for page creation") + $ do createPage name + updatePage name case ret of - Left _ -> - return Conflict - Right _ -> - return Created + Left _ -> return Conflict + Right _ -> return Created where renamePage :: PageName -> PageName -> Txn () renamePage oldName newName = fail "FIXME: renamePage: not implemented yet" - createPageIfNeeded :: PageName -> Txn () - createPageIfNeeded name + createPage :: PageName -> Txn () + createPage name = do let path = mkPagePath name - kind <- checkPath path - case kind of - NoNode -> do createParentDirectories path - makeFile path - FileNode -> return () - DirNode -> fail ("createPageIfNeeded: already exists a directory: " ++ path) + createParentDirectories path + makeFile path createParentDirectories :: FilePath -> Txn () createParentDirectories path = do let parentPath = takeDirectory path kind <- checkPath parentPath case kind of - NoNode -> createParentDirectories parentPath + NoNode -> do createParentDirectories parentPath + makeDirectory parentPath FileNode -> fail ("createParentDirectories: already exists a file: " ++ parentPath) DirNode -> return () @@ -225,3 +232,14 @@ putPageIntoRepository repos page encodeFlag :: Bool -> Maybe String encodeFlag True = Just "*\n" encodeFlag False = Nothing + + +filterSvnError :: IO a -> IO a +filterSvnError f = catchDyn f rethrow + where + rethrow :: SvnError -> IO a + rethrow err + = let code = svnErrCode err + msg = svnErrMsg err + in + fail $ "SvnError: " ++ (show code) ++ ": " ++ msg diff --git a/Rakka/Wiki/Interpreter/Base.hs b/Rakka/Wiki/Interpreter/Base.hs index 70951e6..6feb92a 100644 --- a/Rakka/Wiki/Interpreter/Base.hs +++ b/Rakka/Wiki/Interpreter/Base.hs @@ -23,6 +23,7 @@ interpreters = [ lineBreakInterp , divInterp , pageNameInterp , otherLangsInterp + , newPageInterp , editPageInterp ] @@ -100,6 +101,30 @@ otherLangsInterp = [Inline (PageLink (Just name) Nothing (Just langName))] +-- +newPageInterp :: Interpreter +newPageInterp + = InlineCommandInterpreter { + iciName = "newPage" + , iciInterpret + = \ ctx (InlineCommand _ args _) -> + do BaseURI baseURI <- getSysConf (ctxSysConf ctx) + + let label = fromMaybe "Create new page" (lookup "label" args) + uri = uriToString id baseURI "" + attrs = [ ("type" , "button") + , ("value" , label) + , ("onclick", "Rakka.newPage(\"" ++ uri ++ "\")") + , ("class" , "newButton") + ] + + return (Input attrs) + } + + -- * = In other languages = diff --git a/js/editPage.js b/js/editPage.js index 0eb211e..43dc776 100644 --- a/js/editPage.js +++ b/js/editPage.js @@ -33,11 +33,15 @@ Rakka.editPage = function (baseURI, pageName) { }); }; +Rakka.newPage = function (baseURI) { + Rakka.displayPageEditor(baseURI, "", null, "rakka", null); +}; + Rakka.displayPageEditor = function (baseURI, pageName, oldRevision, defaultType, source) { var $area = Rakka.switchScreen(); $area.empty(); - $area.append($.H1({}, "Edit page")); + $area.append($.H1({}, pageName == "" ? "Create page" : "Edit page")); var fldPageName = $.INPUT({type : "text", value: pageName}); diff --git a/schemas/rakka-page-1.0.rng b/schemas/rakka-page-1.0.rng index 29e4036..6466040 100644 --- a/schemas/rakka-page-1.0.rng +++ b/schemas/rakka-page-1.0.rng @@ -51,36 +51,40 @@ - - + + yes + no + - - + + yes + no + - - + + yes + no + - - + + yes + no + -- 2.40.0