Record before an experiment

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

diff --git a/Rakka/Resource/Render.hs b/Rakka/Resource/Render.hs
index df141b13ee2445db2df690fb8094ca54427c520a..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,29 +153,30 @@ 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 pageTitle)
+                              += ( (constA (pageName page) &&& constA (Just page) &&& constA pageTitle)
                                    >>>
                                    formatSubPage env
                                  )
                             )
                          += ( eelem "sideBar"
                               += ( eelem "left"
-                                   += ( (constA (pageName page) &&& constA leftSideBar)
+                                   += ( (constA (pageName page) &&& constA (Just page) &&& constA leftSideBar)
                                         >>>
                                         formatSubPage env
                                       )
                                  )
                               += ( eelem "right"
-                                   += ( (constA (pageName page) &&& constA rightSideBar)
+                                   += ( (constA (pageName page) &&& constA (Just page) &&& constA rightSideBar)
                                         >>>
                                         formatSubPage env
                                       )
@@ -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()"
@@ -293,20 +306,20 @@ handlePageNotFound env
                          += sattr "name"       name
                          
                          += ( eelem "pageTitle"
-                              += ( (constA name &&& constA pageTitle)
+                              += ( (constA name &&& constA Nothing &&& constA pageTitle)
                                    >>>
                                    formatSubPage env
                                  )
                             )
                          += ( eelem "sideBar"
                               += ( eelem "left"
-                                   += ( (constA name &&& constA leftSideBar)
+                                   += ( (constA name &&& constA Nothing &&& constA leftSideBar)
                                         >>>
                                         formatSubPage env
                                       )
                                  )
                               += ( eelem "right"
-                                   += ( (constA name &&& constA rightSideBar)
+                                   += ( (constA name &&& constA Nothing &&& constA rightSideBar)
                                         >>>
                                         formatSubPage env
                                       )