From: pho <pho@cielonegro.org>
Date: Sun, 16 Dec 2007 06:26:52 +0000 (+0900)
Subject: we can now create new pages
X-Git-Url: https://git.cielonegro.org/gitweb.cgi?a=commitdiff_plain;h=743f4a87fd557832ce67d6eb51749582820577c4;p=Rakka.git

we can now create new pages

darcs-hash:20071216062652-62b54-61857b2af474cb50fc497e41d96b630cd838523e.gz
---

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))]
 
 
+-- <input type="button"
+--        value="Create new page"
+--        onclick="Rakka.newPage(\"http://example.org/\")"
+--        class="newButton" />
+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)
+      }
+
+
 -- <input type="button"
 --        value="Edit"
 --        onclick="Rakka.editPage(\"http://example.org/\", \"Foo\")"
diff --git a/defaultPages/SideBar/Right.xml b/defaultPages/SideBar/Right.xml
index c43cef1..41699d1 100644
--- a/defaultPages/SideBar/Right.xml
+++ b/defaultPages/SideBar/Right.xml
@@ -4,6 +4,7 @@
       isBoring="yes">
   <textData><![CDATA[
 = Control =
+* <newPage />
 * <editPage />
 
 = 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 @@
       <optional>
         <!-- text/css でなければ無視される -->
         <attribute name="isTheme">
-          <!-- これは HXT が對應してゐない。
-               <data type="string">
-               <param name="pattern">yes|no</param>
-               </data>
-          -->
-          <text />
+          <choice>
+            <value>yes</value>
+            <value>no</value>
+          </choice>
         </attribute>
       </optional>
 
       <optional>
         <!-- text/x-rakka でなければ無視される -->
         <attribute name="isFeed">
-          <!-- yes/no -->
-          <text />
+          <choice>
+            <value>yes</value>
+            <value>no</value>
+          </choice>
         </attribute>
       </optional>
 
       <optional>
         <!-- ログインしてゐないユーザーの編集を禁止するフラグ -->
         <attribute name="isLocked">
-          <!-- yes/no -->
-          <text />
+          <choice>
+            <value>yes</value>
+            <value>no</value>
+          </choice>
         </attribute>
       </optional>
 
       <optional>
         <!-- 更新履歴や RSS から削除されるフラグ -->
         <attribute name="isBoring">
-          <!-- yes/no -->
-          <text />
+          <choice>
+            <value>yes</value>
+            <value>no</value>
+          </choice>
         </attribute>
       </optional>