Implemented sidebars

[Rakka.git] / Rakka / Resource / Render.hs
diff --git a/Rakka/Resource/Render.hs b/Rakka/Resource/Render.hs

index 6aee49f684dbe0f63f5122aa5f85049439bc5e72..27671dac98738115ac85a815f7d41c9bb06bd4e0 100644 (file)
--- a/Rakka/Resource/Render.hs
+++ b/Rakka/Resource/Render.hs
@@ -89,9 +89,22 @@ handleRedirect env
        <link lang="ja" page="Bar/Baz" />
      </otherLang>
  
-    <content>
+    <pageTitle>
        blah blah...
-    </content>
+    </pageTitle>
+
+    <sideBar>
+      <left>
+        blah blah...
+      </left>
+      <right>
+        blah blah...
+      </right>
+    </sideBar>
+
+    <body>
+      blah blah...
+    </body>
    </page>
  -}
  handleGetEntity :: (ArrowXml a, ArrowChoice a, ArrowIO a) => Environment -> a Page (Resource ())
@@ -103,6 +116,10 @@ handleGetEntity env
                  BaseURI    baseURI  <- getSysConfA sysConf (BaseURI    undefined) -< ()
                  StyleSheet cssName  <- getSysConfA sysConf (StyleSheet undefined) -< ()
  
+                Just pageTitle    <- getPageA (envStorage env) -< "PageTitle"
+                Just leftSideBar  <- getPageA (envStorage env) -< "SideBar/Left"
+                Just rightSideBar <- getPageA (envStorage env) -< "SideBar/Right"
+
                  tree <- ( eelem "/"
                            += ( eelem "page"
                                 += sattr "site"       siteName
@@ -139,8 +156,28 @@ handleGetEntity env
                                                += sattr "page" page
                                                    | (lang, page) <- xs ]
                                    )
-                               += ( eelem "content"
-                                    += (constA page >>> formatPage env )
+                               += ( eelem "pageTitle"
+                                    += ( (constA page &&& constA pageTitle)
+                                         >>>
+                                         formatSubPage env
+                                       )
+                                  )
+                               += ( eelem "sideBar"
+                                    += ( eelem "left"
+                                         += ( (constA page &&& constA leftSideBar)
+                                              >>>
+                                              formatSubPage env
+                                            )
+                                       )
+                                    += ( eelem "right"
+                                         += ( (constA page &&& constA rightSideBar)
+                                              >>>
+                                              formatSubPage env
+                                            )
+                                       )
+                                  )
+                               += ( eelem "body"
+                                    += (constA page >>> formatPage env)
                                    )
                                 >>>
                                 uniqueNamespacesFromDeclAndQNames
@@ -188,10 +225,11 @@ entityToXHTML
                       += sattr "class" "center"
                       += ( eelem "div"
                            += sattr "class" "title"
+                          += getXPathTreesInDoc "/page/pageTitle/*"
                          )
                       += ( eelem "div"
                            += sattr "class" "body"
-                          += getXPathTreesInDoc "/page/content/*"
+                          += getXPathTreesInDoc "/page/body/*"
                          )
                     )
                  += ( eelem "div"
@@ -201,12 +239,14 @@ entityToXHTML
                       += sattr "class" "left sideBar"
                       += ( eelem "div"
                            += sattr "class" "content"
+                          += getXPathTreesInDoc "/page/sideBar/left/*"
                          )
                     )
                  += ( eelem "div"
                       += sattr "class" "right sideBar"
                       += ( eelem "div"
                            += sattr "class" "content"
+                          += getXPathTreesInDoc "/page/sideBar/right/*"
                          )
                     )
                )