Record before an experiment

[Rakka.git] / Rakka / Resource / Render.hs

diff --git a/Rakka/Resource/Render.hs b/Rakka/Resource/Render.hs
index 698e789e7467c1ce86fc6b6a0f4c99686f9095c0..51d44fe50f047c37a037808dc47ade488ebc84e6 100644 (file)
--- a/Rakka/Resource/Render.hs
+++ b/Rakka/Resource/Render.hs
@@ -5,8 +5,10 @@ module Rakka.Resource.Render
 
 import           Control.Arrow
 import           Control.Arrow.ArrowIO
+import           Control.Arrow.ArrowIf
 import           Control.Arrow.ArrowList
 import           Data.Char
+import qualified Data.Map as M
 import           Network.HTTP.Lucu
 import           Network.HTTP.Lucu.Utils
 import           Network.URI
@@ -56,7 +58,7 @@ handleGet env name
             Just redir@(Redirection _ _ _ _)
                 -> handleRedirect env -< redir
 
-            Just entity@(Entity _ _ _ _ _ _ _ _ _ _ _ _)
+            Just entity@(Entity _ _ _ _ _ _ _ _ _ _ _ _ _)
                 -> handleGetEntity env -< entity
 
 {-
@@ -75,6 +77,7 @@ handleRedirect env
         styleSheet="http://example.org/object/StyleSheet/Default"
         name="Foo/Bar"
         type="text/x-rakka"
+        lang="ja"           -- 存在しない場合もある
         isTheme="no"        -- text/css の場合のみ存在
         isFeed="no"         -- text/x-rakka の場合のみ存在
         isLocked="no"
@@ -124,6 +127,10 @@ handleGetEntity env
                          += sattr "styleSheet" (uriToString id (mkObjectURI baseURI cssName) "")
                          += sattr "name"       (pageName page)
                          += sattr "type"       (show $ pageType page)
+                         += ( case pageLanguage page of
+                                Just x -> sattr "lang" x
+                                _      -> none
+                            )
                          += ( case pageType page of
                                 MIMEType "text" "css" _
                                     -> sattr "isTheme" (yesOrNo $ pageIsTheme page)
@@ -146,13 +153,14 @@ handleGetEntity env
                                 Just s  -> eelem "summary" += txt s
                             )
 
-                         += ( case pageOtherLang page of
-                                [] -> none
-                                xs -> selem "otherLang"
-                                      [ eelem "link"
-                                        += sattr "lang" lang
-                                        += sattr "page" page
-                                            | (lang, page) <- xs ]
+                         += ( if M.null (pageOtherLang page) then
+                                  none
+                              else
+                                  selem "otherLang"
+                                            [ eelem "link"
+                                              += sattr "lang" lang
+                                              += sattr "page" page
+                                                  | (lang, page) <- M.toList (pageOtherLang page) ]
                             )
                          += ( eelem "pageTitle"
                               += ( (constA (pageName page) &&& constA (Just page) &&& constA pageTitle)
@@ -205,6 +213,11 @@ entityToXHTML
     = eelem "/"
       += ( eelem "html"
            += sattr "xmlns" "http://www.w3.org/1999/xhtml"
+           += ( getXPathTreesInDoc "/page/@lang"
+                `guards`
+                qattr (QN "xml" "lang" "")
+                          ( getXPathTreesInDoc "/page/@lang/text()" )
+              )
            += ( eelem "head"
                 += ( eelem "title"
                      += getXPathTreesInDoc "/page/@site/text()"