From 859d4378c2e2a1ccc8028821a37eeaa43aaa23fb Mon Sep 17 00:00:00 2001
From: pho <pho@cielonegro.org>
Date: Sun, 28 Oct 2007 10:14:55 +0900
Subject: [PATCH] preparation for javascripts

darcs-hash:20071028011455-62b54-c3e5018130a8fa923d2fdbfb1a1529af29bcf09a.gz
---
 .boring                            |  4 ++++
 Main.hs                            |  2 ++
 Makefile                           |  1 +
 Rakka.cabal                        |  3 ++-
 Rakka/Page.hs                      | 31 +++++++++++++++++++++---------
 Rakka/Resource/Render.hs           | 22 ++++++++++++++++++---
 Rakka/Wiki/Engine.hs               | 13 ++++++++++++-
 Rakka/Wiki/Formatter.hs            |  2 +-
 Rakka/Wiki/Interpreter/PageList.hs |  8 ++++----
 defaultPages/StyleSheet/Default    |  4 ++++
 js/Makefile                        | 29 ++++++++++++++++++++++++++++
 11 files changed, 100 insertions(+), 19 deletions(-)
 create mode 100644 js/Makefile

diff --git a/.boring b/.boring
index 0a5b28a..d833803 100644
--- a/.boring
+++ b/.boring
@@ -55,3 +55,7 @@
 ^configure$
 ^dist(/|$)
 ^repos(/|$)
+
+^Rakka/Resource/JavaScript\.hs$
+^js/jquery-
+^js/yuicompressor\.jar$
diff --git a/Main.hs b/Main.hs
index 90a47ef..8027c7e 100644
--- a/Main.hs
+++ b/Main.hs
@@ -6,6 +6,7 @@ import           Network
 import           Network.HTTP.Lucu
 import           Rakka.Environment
 import           Rakka.Resource.Index
+import           Rakka.Resource.JavaScript
 import           Rakka.Resource.Object
 import           Rakka.Resource.Render
 import           Rakka.Storage
@@ -134,6 +135,7 @@ resTree :: Environment -> ResTree
 resTree env
     = mkResTree [ ([]        , resIndex  env)
                 , (["object"], resObject env)
+                , (["js"    ], javaScript   )
                 ]
 
 
diff --git a/Makefile b/Makefile
index a130eff..99956d4 100644
--- a/Makefile
+++ b/Makefile
@@ -3,6 +3,7 @@ GHC        = ghc
 EXECUTABLE = sudo ./dist/build/rakka/rakka -p 8989 -l DEBUG
 
 build: .setup-config Setup
+	$(MAKE) -C js $@
 	./Setup build
 
 run: build
diff --git a/Rakka.cabal b/Rakka.cabal
index d536f4f..c8b62c1 100644
--- a/Rakka.cabal
+++ b/Rakka.cabal
@@ -23,7 +23,7 @@ Tested-With:
 Build-Depends:
     Crypto, FileManip, HUnit, HsHyperEstraier >= 0.2, HsSVN, Lucu,
     base, encoding, filepath, hslogger, hxt, mtl, network, parsec,
-    stm, unix
+    stm, unix, zlib
 Data-Files:
     defaultpages/Help/SampleImage/Large
     defaultpages/Help/SampleImage/Small
@@ -45,6 +45,7 @@ Other-Modules:
     Rakka.Page
     Rakka.Resource
     Rakka.Resource.Index
+    Rakka.Resource.JavaScript
     Rakka.Resource.Object
     Rakka.Resource.Render
     Rakka.Storage
diff --git a/Rakka/Page.hs b/Rakka/Page.hs
index 1fd54c9..ec6ce80 100644
--- a/Rakka/Page.hs
+++ b/Rakka/Page.hs
@@ -12,6 +12,7 @@ module Rakka.Page
     , mkPageURI
     , mkPageFragmentURI
     , mkObjectURI
+    , mkFragmentURI
     , mkAuxiliaryURI
     , mkRakkaURI
     )
@@ -64,24 +65,29 @@ data Page
 
 -- UTF-8 に encode してから 0x20 - 0x7E の範圍を除いて URI escape する。
 encodePageName :: PageName -> FilePath
-encodePageName = escapeURIString isSafe . C8.unpack . encode UTF8 . fixPageName
+encodePageName = escapeURIString isSafeChar . C8.unpack . encode UTF8 . fixPageName
     where
-      isSafe :: Char -> Bool
-      isSafe c
-          | c == '/'             = True
-          | isReserved c         = False
-          | c >= ' ' && c <= '~' = True
-          | otherwise            = False
-
       fixPageName :: PageName -> PageName
       fixPageName = (\ (x:xs) -> toUpper x : xs) . map (\ c -> if c == ' ' then '_' else c)
 
 
+isSafeChar :: Char -> Bool
+isSafeChar c
+    | c == '/'            = True
+    | isReserved c        = False
+    | c > ' ' && c <= '~' = True
+    | otherwise           = False
+
+
 -- URI unescape して UTF-8 から decode する。
 decodePageName :: FilePath -> PageName
 decodePageName = decode UTF8 . C8.pack . unEscapeString
 
 
+encodeFragment :: String -> String
+encodeFragment = escapeURIString isSafeChar . C8.unpack . encode UTF8
+
+
 pageFileName' :: Page -> String
 pageFileName' page = fromMaybe (defaultFileName page) (pageFileName page)
 
@@ -107,7 +113,14 @@ mkPageFragmentURI :: URI -> PageName -> String -> URI
 mkPageFragmentURI baseURI name fragment
     = baseURI {
         uriPath     = foldl (</>) "/" [uriPath baseURI, encodePageName name ++ ".html"]
-      , uriFragment = ('#':fragment)
+      , uriFragment = ('#' : encodeFragment fragment)
+      }
+
+
+mkFragmentURI :: String -> URI
+mkFragmentURI fragment
+    = nullURI {
+        uriFragment = ('#' : encodeFragment fragment)
       }
 
 
diff --git a/Rakka/Resource/Render.hs b/Rakka/Resource/Render.hs
index 66a1516..cb01bcd 100644
--- a/Rakka/Resource/Render.hs
+++ b/Rakka/Resource/Render.hs
@@ -70,7 +70,6 @@ handleRedirect env
 
 {-
   <page site="CieloNegro"
-        styleSheet="http://example.org/object/StyleSheet/Default"
         name="Foo/Bar"
         type="text/x-rakka"
         lang="ja"            -- 存在しない場合もある
@@ -82,6 +81,14 @@ handleRedirect env
         revision="112">      -- デフォルトでない場合のみ存在
         lastModified="2000-01-01T00:00:00">
 
+    <styleSheets>
+      <styleSheet src="http://example.org/object/StyleSheet/Default" />
+    </styleSheets>
+
+    <scripts>
+      <script src="http://example.org/js" />
+    </scripts>
+
     <summary>
         blah blah...
     </summary> -- 存在しない場合もある
@@ -143,11 +150,20 @@ entityToXHTML
                      += txt " - "
                      += getXPathTreesInDoc "/page/@name/text()"
                    )
-                += ( eelem "link"
+                += ( getXPathTreesInDoc "/page/styleSheets/styleSheet"
+                     >>>
+                     eelem "link"
                      += sattr "rel"  "stylesheet"
                      += sattr "type" "text/css"
                      += attr "href"
-                            ( getXPathTreesInDoc "/page/@styleSheet/text()" )
+                            ( getXPathTrees "/styleSheet/@src/text()" )
+                   )
+                += ( getXPathTreesInDoc "/page/scripts/script"
+                     >>>
+                     eelem "script"
+                     += sattr "type" "text/javascript"
+                     += attr "src"
+                            ( getXPathTrees "/script/@src/text()" )
                    )
               )
            += ( eelem "body"
diff --git a/Rakka/Wiki/Engine.hs b/Rakka/Wiki/Engine.hs
index afbc610..0f18fb1 100644
--- a/Rakka/Wiki/Engine.hs
+++ b/Rakka/Wiki/Engine.hs
@@ -53,7 +53,6 @@ formatEntirePage sto sysConf interpTable
           tree <- ( eelem "/"
                     += ( eelem "page"
                          += sattr "site"       siteName
-                         += sattr "styleSheet" (uriToString id (mkObjectURI baseURI cssName) "")
                          += sattr "name"       (pageName page)
                          += sattr "type"       (show $ pageType page)
                          += ( case pageLanguage page of
@@ -80,6 +79,18 @@ formatEntirePage sto sysConf interpTable
                          += sattr "revision" (show $ pageRevision page)
                          += sattr "lastModified" (formatW3CDateTime $ pageLastMod page)
 
+                         += ( eelem "styleSheets"
+                              += ( eelem "styleSheet"
+                                   += sattr "src" (uriToString id (mkObjectURI baseURI cssName) "")
+                                 )
+                            )
+
+                         += ( eelem "scripts"
+                              += ( eelem "script"
+                                   += sattr "src" (uriToString id (baseURI { uriPath = "/js" }) "")
+                                 )
+                            )
+
                          += ( case pageSummary page of
                                 Nothing -> none
                                 Just s  -> eelem "summary" += txt s
diff --git a/Rakka/Wiki/Formatter.hs b/Rakka/Wiki/Formatter.hs
index 3f09606..1c3abe5 100644
--- a/Rakka/Wiki/Formatter.hs
+++ b/Rakka/Wiki/Formatter.hs
@@ -229,7 +229,7 @@ formatPageLink
     -> let uri    = case (page, fragment) of
                       (Just  x, Just  y) -> mkPageFragmentURI baseURI x y
                       (Just  x, Nothing) -> mkPageURI baseURI x
-                      (Nothing, Just  y) -> nullURI { uriFragment = ('#':y) }
+                      (Nothing, Just  y) -> mkFragmentURI y
            href   = uriToString id uri ""
            dLabel = fromMaybe "" page ++ fromMaybe "" (fmap ('#':) fragment)
            label  = fromMaybe dLabel text
diff --git a/Rakka/Wiki/Interpreter/PageList.hs b/Rakka/Wiki/Interpreter/PageList.hs
index 2a10372..69ff0e7 100644
--- a/Rakka/Wiki/Interpreter/PageList.hs
+++ b/Rakka/Wiki/Interpreter/PageList.hs
@@ -20,7 +20,7 @@ interpreters = [ recentUpdatesInterp ]
 --   <ul>
 --     <li>
 --       <a href="...">...</a>
---       <span class="date">...</span>
+--       <div class="date">...</div>
 --       <p> <!-- サマリが無ければ存在しない -->
 --         blah blah...
 --       </p>
@@ -65,9 +65,9 @@ recentUpdatesInterp
                        , linkText     = Nothing
                        }
                     )
-            , Inline ( Span [("class", "date")]
-                                [Text (formatRFC1123DateTime (pageLastMod page))]
-                     )
+            , Block ( Div [("class", "date")]
+                              [Inline (Text (formatRFC1123DateTime (pageLastMod page)))]
+                    )
             ]
             ++
             case pageSummary page of
diff --git a/defaultPages/StyleSheet/Default b/defaultPages/StyleSheet/Default
index 562e02b..b2c3693 100644
--- a/defaultPages/StyleSheet/Default
+++ b/defaultPages/StyleSheet/Default
@@ -147,6 +147,10 @@
     margin-top: 1.2em;
 }
 
+.sideBar .date {
+    padding: 0.2em 0 0 0;
+}
+
 /* color and text *************************************************************/
 * {
     font-family: sans-serif;
diff --git a/js/Makefile b/js/Makefile
new file mode 100644
index 0000000..a5c163b
--- /dev/null
+++ b/js/Makefile
@@ -0,0 +1,29 @@
+SOURCES = \
+	jquery-1.2.1.js \
+	$(NULL)
+
+
+build: ../Rakka/Resource/JavaScript.hs
+
+
+../Rakka/Resource/JavaScript.hs: $(SOURCES) yuicompressor.jar
+	cat $(SOURCES) > tmp.js
+	java -jar yuicompressor.jar --type js --charset UTF-8 -o tmp.packed.js --warn tmp.js
+	lucu-implant-file -o $@ -m Rakka.Resource.JavaScript -t text/javascript tmp.packed.js
+	rm tmp.js tmp.packed.js
+
+
+jquery-%.js:
+	@echo "Error: $@ has to be placed on this directory."
+	@echo "       See http://jquery.com/"
+	@exit 1
+
+
+clean:
+	rm -f ../Rakka/Resource/JavaScript.hs
+
+
+yuicompressor.jar:
+	@echo "Error: yuicompressor.jar has to be placed on this directory."
+	@echo "       See http://www.julienlecomte.net/yuicompressor/"
+	@exit 1
-- 
2.40.0